diff --git a/.github/actions/compile-and-test/entrypoint.sh b/.github/actions/compile-and-test/entrypoint.sh index 8d1b38cdc2..62de74efd8 100755 --- a/.github/actions/compile-and-test/entrypoint.sh +++ b/.github/actions/compile-and-test/entrypoint.sh @@ -24,7 +24,7 @@ cd /openfast # Display the differences between this commit and `dev` echo git-diff from ${GITHUB_REF} to dev: -git diff dev +git diff dev --numstat # Move into the "build" directory, remove the old reg tests, and compile cd /openfast/build diff --git a/.gitignore b/.gitignore index da5ea6ff03..2db6788dfe 100644 --- a/.gitignore +++ b/.gitignore @@ -44,6 +44,7 @@ vs-build/ # backup files *.asv +~$*.xlsx # LaTeX compiling files *.aux diff --git a/README.rst b/README.rst index 2155ba2f14..76e3affe43 100644 --- a/README.rst +++ b/README.rst @@ -29,7 +29,7 @@ FAST v8 - OpenFAST v0.1.0 The transition from FAST v8 to OpenFAST v0.1.0 represents the effort to better support an open-source developer community around FAST-based aero-hydro-servo- elastic engineering models of wind-turbines and wind-plants. OpenFAST is the -next generation of FAST analysis tools. More inforation is available in the +next generation of FAST analysis tools. More information is available in the `transition notes `_. FAST v8 is a computer-aided engineering tool for simulating the coupled dynamic @@ -116,7 +116,7 @@ OpenFAST on Unix-based and Windows machines are available at `readthedocs `_ to: +Please use `GitHub Issues `_ to: * ask usage questions * report bugs diff --git a/docs/OtherSupporting/OutListParameters.xlsx b/docs/OtherSupporting/OutListParameters.xlsx index 2bd9818fc5..ceca7ef7db 100644 Binary files a/docs/OtherSupporting/OutListParameters.xlsx and b/docs/OtherSupporting/OutListParameters.xlsx differ diff --git a/docs/source/user/aerodyn/ADNodalOutputs.rst b/docs/source/user/aerodyn/ADNodalOutputs.rst new file mode 100644 index 0000000000..a820b42c25 --- /dev/null +++ b/docs/source/user/aerodyn/ADNodalOutputs.rst @@ -0,0 +1,42 @@ +.. _AD-Nodal-Outputs: + +Nodal Outputs +~~~~~~~~~~~~~ + +In addition to the named outputs in :numref:`AD-Outputs` above, AeroDyn allows +for outputting the full set blade node motions and loads (tower nodes +unavailable at present). Please refer to the AeroDyn_Nodes tab in the +Excel file :download:`OutListParameters.xlsx <../../../OtherSupporting/OutListParameters.xlsx>` +for a complete list of possible output parameters. + +This section follows the `END` statement from normal Outputs section described +above, and includes a separator description line followed by the following +optinos. + +**BldNd_BladesOut** specifies the number of blades to output. Possible values +are 0 through the number of blades AeroDyn is modeling. If the value is set to +1, only blade 1 will be output, and if the value is 2, blades 1 and 2 will be +output. + +**BldNd_BlOutNd** specifies which nodes to output. This is currently unused. + +The **OutList** section controls the nodal output quantities generated by +AeroDyn. In this section, the user specifies the name of the channel family to +output. The output name for each channel is then created internally by AeroDyn +by combining the blade number, node number, and channel family name. For +example, if the user specifies **AxInd** as the channel family name, the output +channels will be named with the convention of **B**\ :math:`\mathbf{\beta}`\ +**N###AxInd** where :math:`\mathbf{\beta}` is the blade number, and **###** is +the three digit node number. + + +Sample Nodal Outputs section +^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + +This sample includes the ``END`` statement from the regular outputs section. + +.. container:: + :name: File:ADNodalOutputs + + .. literalinclude:: examples/NodalOutputs.txt + :linenos: diff --git a/docs/source/user/aerodyn/examples/NodalOutputs.txt b/docs/source/user/aerodyn/examples/NodalOutputs.txt new file mode 100644 index 0000000000..3445cec6ec --- /dev/null +++ b/docs/source/user/aerodyn/examples/NodalOutputs.txt @@ -0,0 +1,48 @@ +END of input file (the word "END" must appear in the first 3 columns of this last OutList line) +---------------------- NODE OUTPUTS -------------------------------------------- + 3 BldNd_BladesOut - Blades to output + 99 BldNd_BlOutNd - Blade nodes on each blade (currently unused) + OutList - The next line(s) contains a list of output parameters. See OutListParameters.xlsx, AeroDyn_Nodes tab for a listing of available output channels, (-) +"VUndx" - x-component of undisturbed wind velocity at each node +"VUndy" - y-component of undisturbed wind velocity at each node +"VUndz" - z-component of undisturbed wind velocity at each node +"VDisx" - x-component of disturbed wind velocity at each node +"VDisy" - y-component of disturbed wind velocity at each node +"VDisz" - z-component of disturbed wind velocity at each node +"STVx" - x-component of structural translational velocity at each node +"STVy" - y-component of structural translational velocity at each node +"STVz" - z-component of structural translational velocity at each node +"VRel" - Relvative wind speed at each node +"DynP" - Dynamic pressure at each node +"Re" - Reynolds number (in millions) at each node +"M" - Mach number at each node +"Vindx" - Axial induced wind velocity at each node +"Vindy" - Tangential induced wind velocity at each node +"AxInd" - Axial induction factor at each node +"TnInd" - Tangential induction factor at each node +"Alpha" - Angle of attack at each node +"Theta" - Pitch+Twist angle at each node +"Phi" - Inflow angle at each node +"Curve" - Curvature angle at each node +"Cl" - Lift force coefficient at each node +"Cd" - Drag force coefficient at each node +"Cm" - Pitching moment coefficient at each node +"Cx" - Normal force (to plane) coefficient at each node +"Cy" - Tangential force (to plane) coefficient at each node +"Cn" - Normal force (to chord) coefficient at each node +"Ct" - Tangential force (to chord) coefficient at each node +"Fl" - Lift force per unit length at each node +"Fd" - Drag force per unit length at each node +"Mm" - Pitching moment per unit length at each node +"Fx" - Normal force (to plane) per unit length at each node +"Fy" - Tangential force (to plane) per unit length at each node +"Fn" - Normal force (to chord) per unit length at each node +"Ft" - Tangential force (to chord) per unit length at each node +"Clrnc" - Tower clearance at each node (based on the absolute distance to the nearest point in the tower from blade node B#N# minus the local tower radius, in the deflected configuration); please note that this clearance is only approximate because the calculation assumes that the blade is a line with no volume (however, the calculation does use the local tower radius); when blade node B#N# is above the tower top (or below the tower base), the absolute distance to the tower top (or base) minus the local tower radius, in the deflected configuration, is output +"Vx" - Local axial velocity +"Vy" - Local tangential velocity +"GeomPhi" - Geometric phi? If phi was solved using normal BEMT equations, GeomPhi = 1; otherwise, if it was solved geometrically, GeomPhi = 0. +"Chi" - Skew angle (used in skewed wake correction) +"UA_Flag" - Flag indicating if UA is turned on for this node. +END of input file (the word "END" must appear in the first 3 columns of this last OutList line) +--------------------------------------------------------------------------------------- diff --git a/docs/source/user/aerodyn/examples/ad_primary_example.inp b/docs/source/user/aerodyn/examples/ad_primary_example.inp index d4e6b5a685..d3ca180f54 100644 --- a/docs/source/user/aerodyn/examples/ad_primary_example.inp +++ b/docs/source/user/aerodyn/examples/ad_primary_example.inp @@ -31,7 +31,7 @@ True TIDrag - Include the drag term in the tangential-induc 2 DBEMT_Mod - Type of dynamic BEMT (DBEMT) model {1=constant tau1, 2=time-dependent tau1} (-) [used only when WakeMod=2] 4 tau1_const - Time constant for DBEMT (s) [used only when WakeMod=2 and DBEMT_Mod=1] ====== Beddoes-Leishman Unsteady Airfoil Aerodynamics Options ===================================== [used only when AFAeroMod=2] - 1 UAMod - Unsteady Aero Model Switch (switch) {1=Baseline model (Original), 2=Gonzalez's variant (changes in Cn,Cc,Cm), 3=Minemma/Pierce variant (changes in Cc and Cm)} [used only when AFAeroMod=2] + 1 UAMod - Unsteady Aero Model Switch (switch) {1=Baseline model (Original), 2=Gonzalez's variant (changes in Cn,Cc,Cm), 3=Minnema/Pierce variant (changes in Cc and Cm)} [used only when AFAeroMod=2] FALSE FLookup - Flag to indicate whether a lookup for f' will be calculated (TRUE) or whether best-fit exponential equations will be used (FALSE); if FALSE S1-S4 must be provided in airfoil input files (flag) [used only when AFAeroMod=2] ====== Airfoil Information ========================================================================= 1 AFTabMod - Interpolation method for multiple airfoil tables {1=1D interpolation on AoA (first table only); 2=2D interpolation on AoA and Re; 3=2D interpolation on AoA and UserProp} (-) @@ -82,5 +82,19 @@ True SumPrint - Generate a summary file listing input option "B1N1AxInd, B1N2AxInd, B1N3AxInd" "B1N1Alpha, B1N2Alpha, B1N3Alpha" "B1N1Theta, B1N2Theta, B1N3Theta" -END of input file (the word "END" must appear in the first 3 columns of this last OutList line) ---------------------------------------------------------------------------------------- +END of OutList section (the word "END" must appear in the first 3 columns of the last OutList line) +====== Outputs for all blade stations (same ending as above for B1N1.... =========================== [optional section] + 1 BldNd_BladesOut - Number of blades to output all node information at. Up to number of blades on turbine. (-) + "All" BldNd_BlOutNd - Future feature will allow selecting a portion of the nodes to output. Not implemented yet. (-) + OutList - The next line(s) contains a list of output parameters. See OutListParameters.xlsx for a listing of available output channels, (-) +"Fx, Fy" +"Vx, Vy" +Vrel +TnInd +AxInd +Theta +Phi +Vindx +Vindy +Alpha +END (the word "END" must appear in the first 3 columns of this last OutList line in the optional nodal output section) diff --git a/docs/source/user/aerodyn/input.rst b/docs/source/user/aerodyn/input.rst index 0cc938ee7c..11d193cd98 100644 --- a/docs/source/user/aerodyn/input.rst +++ b/docs/source/user/aerodyn/input.rst @@ -10,10 +10,11 @@ file is required. This driver file specifies initialization inputs normally provided to AeroDyn by OpenFAST, as well as the per-time-step inputs to AeroDyn. -As an example, the ``driver.dvr`` file is the main driver, the ``input.dat`` is the primary input file, the ``blade.dat`` file contains the blade -geometry data, and the ``airfoil.dat`` file contains the airfoil -angle of attack, lift, drag, moment coefficients, and pressure -coefficients. Example input files are included in :numref:`ad_appendix`. +As an example, the ``driver.dvr`` file is the main driver, the ``input.dat`` is +the primary input file, the ``blade.dat`` file contains the blade geometry data, +and the ``airfoil.dat`` file contains the airfoil angle of attack, lift, drag, +moment coefficients, and pressure coefficients. Example input files are +included in :numref:`ad_appendix`. No lines should be added or removed from the input files, except in tables where the number of rows is specified and comment lines in the @@ -151,11 +152,11 @@ for ``DTAero`` may be used to indicate that AeroDyn should employ the time step prescribed by the driver code (OpenFAST or the standalone driver program). -Set ``WakeMod`` to 0 if you want to disable rotor wake/induction -effects or 1 to include these effects using the (quasi-steady) BEM theory model. When -``WakeMod`` is set to 2, a dynamic BEM theory model (DBEMT) is used (also referred to - as dynamic inflow or dynamic wake model). -``WakeMod`` cannot be set to 2 during linearization analyses. +Set ``WakeMod`` to 0 if you want to disable rotor wake/induction effects or 1 to +include these effects using the (quasi-steady) BEM theory model. When +``WakeMod`` is set to 2, a dynamic BEM theory model (DBEMT) is used (also +referred to as dynamic inflow or dynamic wake model). ``WakeMod`` cannot be set +to 2 during linearization analyses. Set ``AFAeroMod`` to 1 to include steady blade airfoil aerodynamics or 2 to enable UA; ``AFAeroMod`` must be 1 during linearization analyses @@ -361,6 +362,8 @@ specifies the local tower drag-force coefficient. ``TwrElev`` must be entered in monotonically increasing order—from the lowest (tower-base) to the highest (tower-top) elevation. See Figure 2. +.. _AD-Outputs: + Outputs ~~~~~~~ @@ -415,6 +418,9 @@ unknown/invalid channel name, it warns the users but will remove the suspect channel from the output file. Please refer to Appendix E for a complete list of possible output parameters. +.. include:: ADNodalOutputs.rst + + .. _airfoil_data_input_file: Airfoil Data Input File diff --git a/docs/source/user/api_change.rst b/docs/source/user/api_change.rst index dfbc57dd9d..8babd2852b 100644 --- a/docs/source/user/api_change.rst +++ b/docs/source/user/api_change.rst @@ -9,6 +9,27 @@ The changes are tabulated according to the module input file, line number, and f The line number corresponds to the resulting line number after all changes are implemented. Thus, be sure to implement each in order so that subsequent line numbers are correct. +OpenFAST v2.3.0 to OpenFAST `dev` +--------------------------------- + +============== ==== ================== ============================================================================================================================================================================= +Added in OpenFAST `dev` +-------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- + Module Line Flag Name Example Value +============== ==== ================== ============================================================================================================================================================================= +HydroDyn 53 ExctnMod 0 ExctnMod - Wave Excitation model {0: None, 1: DFT, 2: state-space} (-) +OpenFAST 44 CalcSteady true CalcSteady - Calculate a steady-state periodic operating point before linearization? [unused if Linearize=False] (flag) +OpenFAST 45 TrimCase 3 TrimCase - Controller parameter to be trimmed {1:yaw; 2:torque; 3:pitch} [used only if CalcSteady=True] (-) +OpenFAST 46 TrimTol 0.0001 TrimTol - Tolerance for the rotational speed convergence [used only if CalcSteady=True] (-) +OpenFAST 47 TrimGain 0.001 TrimGain - Proportional gain for the rotational speed error (>0) [used only if CalcSteady=True] (rad/(rad/s) for yaw or pitch; Nm/(rad/s) for torque) +OpenFAST 48 Twr_Kdmp 0 Twr_Kdmp - Damping factor for the tower [used only if CalcSteady=True] (N/(m/s)) +OpenFAST 49 Bld_Kdmp 0 Bld_Kdmp - Damping factor for the blades [used only if CalcSteady=True] (N/(m/s)) +InflowWind 48 InitPosition(x) 0.0 InitPosition(x) - Initial offset in +x direction (shift of wind box) [Only used with WindType = 5] (m) +============== ==== ================== ============================================================================================================================================================================= + +Additional nodal output channels added for :ref:`AeroDyn15`, +:ref:`BeamDyn`, and :ref:`ElastoDyn`. + OpenFAST v2.2.0 to OpenFAST v2.3.0 ---------------------------------- @@ -27,24 +48,26 @@ Added in OpenFAST v2.3.0 Module Line Flag Name Example Value ============================================= ==== =============== ======================================================================================================================================================================================================== AeroDyn Airfoil Input File - Airfoil Tables 2 UserProp 0 UserProp ! User property (control) setting -AeroDyn 37 AFTabMod 1 AFTabMod - Interpolation method for multiple airfoil tables {1=1D interpolation on AoA (first table only); 2=2D interpolation on AoA and Re; 3=2D interpolation on AoA and UserProp} (-) +AeroDyn 37 AFTabMod 1 AFTabMod - Interpolation method for multiple airfoil tables {1=1D interpolation on AoA (first table only); 2=2D interpolation on AoA and Re; 3=2D interpolation on AoA and UserProp} (-) ============================================= ==== =============== ======================================================================================================================================================================================================== - OpenFAST v2.1.0 to OpenFAST v2.2.0 ---------------------------------- No changes required. - OpenFAST v2.0.0 to OpenFAST v2.1.0 ---------------------------------- -No changes required. - - +============== ==== ================== ===================================================================================================================================================================== + Added in OpenFAST v2.1.0 +------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------ + Module Line Flag Name Example Value +============== ==== ================== ===================================================================================================================================================================== +BeamDyn driver 21 GlbRotBladeT0 True GlbRotBladeT0 - Reference orientation for BeamDyn calculations is aligned with initial blade root? +============== ==== ================== ===================================================================================================================================================================== OpenFAST v1.0.0 to OpenFAST v2.0.0 ---------------------------------- @@ -63,17 +86,17 @@ Added in OpenFAST v2.0.0 ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- Module Line Flag Name Example Value ========= ==== ================== ===================================================================================================================================================================== -AeroDyn 22 SkewModFactor "default" SkewModFactor - Constant used in Pitt/Peters skewed wake model {or "default" is 15/32*pi} (-) [used only when SkewMod=2; unused when WakeMod=0] +AeroDyn 22 SkewModFactor "default" SkewModFactor - Constant used in Pitt/Peters skewed wake model {or "default" is 15/32*pi} (-) [used only when SkewMod=2; unused when WakeMod=0] AeroDyn 30 Section header ====== Dynamic Blade-Element/Momentum Theory Options ============================================== [used only when WakeMod=2] -AeroDyn 31 DBEMT_Mod 2 DBEMT_Mod - Type of dynamic BEMT (DBEMT) model {1=constant tau1, 2=time-dependent tau1} (-) [used only when WakeMod=2] -AeroDyn 32 tau1_const 4 tau1_const - Time constant for DBEMT (s) [used only when WakeMod=2 and DBEMT_Mod=1] -BeamDyn 5 QuasiStaticInit True QuasiStaticInit - Use quasistatic pre-conditioning with centripetal accelerations in initialization (flag) [dynamic solve only] -BeamDyn 11 load_retries DEFAULT load_retries - Number of factored load retries before quitting the aimulation +AeroDyn 31 DBEMT_Mod 2 DBEMT_Mod - Type of dynamic BEMT (DBEMT) model {1=constant tau1, 2=time-dependent tau1} (-) [used only when WakeMod=2] +AeroDyn 32 tau1_const 4 tau1_const - Time constant for DBEMT (s) [used only when WakeMod=2 and DBEMT_Mod=1] +BeamDyn 5 QuasiStaticInit True QuasiStaticInit - Use quasi-static pre-conditioning with centripetal accelerations in initialization (flag) [dynamic solve only] +BeamDyn 11 load_retries DEFAULT load_retries - Number of factored load retries before quitting the simulation BeamDyn 14 tngt_stf_fd DEFAULT tngt_stf_fd - Flag to use finite differenced tangent stiffness matrix (-) BeamDyn 15 tngt_stf_comp DEFAULT tngt_stf_comp - Flag to compare analytical finite differenced tangent stiffness matrix (-) BeamDyn 16 tngt_stf_pert DEFAULT tngt_stf_pert - perturbation size for finite differencing (-) BeamDyn 17 tngt_stf_difftol DEFAULT tngt_stf_difftol - Maximum allowable relative difference between analytical and fd tangent stiffness (-) -BeamDyn 18 RotStates True RotStates - Orient states in the rotating frame during linearization? (flag) [used only when linearizing] +BeamDyn 18 RotStates True RotStates - Orient states in the rotating frame during linearization? (flag) [used only when linearizing] ========= ==== ================== ===================================================================================================================================================================== @@ -100,6 +123,6 @@ Module Line Flag Name Example Value OpenFAST 18 CompSub 0 CompSub - Compute sub-structural dynamics (switch) {0=None; 1=SubDyn; 2=External Platform MCKF} AeroDyn 12 CavityCheck False CavitCheck - Perform cavitation check? (flag) AeroDyn 17 Patm 9999.9 Patm - Atmospheric pressure (Pa) [used only when CavitCheck=True] -AeroDyn 18 Pvap 9999.9 Pvap - Vapour pressure of fluid (Pa) [used only when CavitCheck=True] +AeroDyn 18 Pvap 9999.9 Pvap - Vapor pressure of fluid (Pa) [used only when CavitCheck=True] AeroDyn 19 FluidDepth 9999.9 FluidDepth - Water depth above mid-hub height (m) [used only when CavitCheck=True] ========== ==== =============== ==================================================================================================== diff --git a/docs/source/user/beamdyn/BDNodalOutputs.rst b/docs/source/user/beamdyn/BDNodalOutputs.rst new file mode 100644 index 0000000000..249bd8d2a1 --- /dev/null +++ b/docs/source/user/beamdyn/BDNodalOutputs.rst @@ -0,0 +1,40 @@ +.. _BD-Nodal-Outputs: + +Nodal Outputs +~~~~~~~~~~~~~ + +In addition to the named outputs in :numref:`BD-Outputs` above, BeamDyn allows +for outputting the full set blade node motions and loads (tower nodes +unavailable at present). Please refer to the BeamDyn_Nodes tab in the +Excel file :download:`OutListParameters.xlsx <../../../OtherSupporting/OutListParameters.xlsx>` +for a complete list of possible output parameters. + +This section follows the `END` statement from normal Outputs section described +above, and includes a separator description line followed by the following +optinos. + +**BldNd_BlOutNd** specifies which nodes to output. This is currently unused. + +The **OutList** section controls the nodal output quantities generated by +BeamDyn. In this section, the user specifies the name of the channel family to +output. The output name for each channel is then created internally by BeamDyn +by combining the blade number, node number, and channel family name. For +example, if the user specifies **TDxr** as the channel family name, the output +channels will be named with the convention of **B**\ :math:`\mathbf{\beta}`\ +**N###TDxr** where :math:`\mathbf{\beta}` is the blade number, and **###** is the +three digit node number. + + + +Sample Nodal Outputs section +^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + +This sample includes the ``END`` statement from the regular outputs section. + +.. container:: + :name: File:BDNodalOutputs + + .. literalinclude:: examples/NodalOutputs.txt + :linenos: + + diff --git a/docs/source/user/beamdyn/appendix.rst b/docs/source/user/beamdyn/appendix.rst index 5412962c4b..41f3023cb6 100644 --- a/docs/source/user/beamdyn/appendix.rst +++ b/docs/source/user/beamdyn/appendix.rst @@ -13,8 +13,7 @@ In this appendix we describe the BeamDyn input-file structure and provide exampl OpenFAST+BeamDyn and stand-alone BeamDyn (static and dynamic) simulations all require two files: 1) BeamDyn primary input file -:download:`(NREL 5MW dynamic example) `, -:download:`(NREL 5MW static example) `: This file includes information on the analysis type (static vs. dynamic), numerical-solution parameters (e.g., numerical damping, quadrature rules), and the geometric definition of the beam reference line via "members" and "key points". This file also specifies the "blade input file." +:download:`(NREL 5MW static example) `: This file includes information on the numerical-solution parameters (e.g., numerical damping, quadrature rules), and the geometric definition of the beam reference line via "members" and "key points". This file also specifies the "blade input file." 2) BeamDyn blade input file :download:`(NREL 5MW example) `: @@ -22,7 +21,7 @@ Stand-alone BeamDyn simulation also require a driver input file; we list here ex 3a) BeamDyn driver for dynamic simulations :download:`(NREL 5MW example) `: This file specifies the inputs for a single blade (e.g., forces, orientations, root velocity) and specifies the BeamDyn primary input file. -3b) BeamDyn driver for static simulations :download:`(NREL 5MW example) `: Same as above but calls the appropriate inputs and primary input file (i.e., here one for static analysis). +3b) BeamDyn driver for static simulations :download:`(NREL 5MW example) `: Same as above but for static analysis. .. _app-output-channel: diff --git a/docs/source/user/beamdyn/examples/NodalOutputs.txt b/docs/source/user/beamdyn/examples/NodalOutputs.txt new file mode 100644 index 0000000000..7a260bc694 --- /dev/null +++ b/docs/source/user/beamdyn/examples/NodalOutputs.txt @@ -0,0 +1,138 @@ +END of input file (the word "END" must appear in the first 3 columns of this last OutList line) +---------------------- NODE OUTPUTS -------------------------------------------- + 99 BldNd_BlOutNd - Blade nodes on each blade (currently unused) + OutList - The next line(s) contains a list of output parameters. See OutListParameters.xlsx, BeamDyn_Nodes tab for a listing of available output channels, (-) +"FxL" - Sectional force resultants at each node expressed in l l: a floating coordinate system local to the deflected beam (N) +"FyL" - Sectional force resultants at each node expressed in l l: a floating coordinate system local to the deflected beam (N) +"FzL" - Sectional force resultants at each node expressed in l l: a floating coordinate system local to the deflected beam (N) +"MxL" - Sectional moment resultants at each node expressed in l l: a floating coordinate system local to the deflected beam (N-m) +"MyL" - Sectional moment resultants at each node expressed in l l: a floating coordinate system local to the deflected beam (N-m) +"MzL" - Sectional moment resultants at each node expressed in l l: a floating coordinate system local to the deflected beam (N-m) +"Fxr" - Sectional force resultants at each node expressed in r r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N) +"Fyr" - Sectional force resultants at each node expressed in r r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N) +"Fzr" - Sectional force resultants at each node expressed in r r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N) +"Mxr" - Sectional moment resultants at each node expressed in r r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N-m) +"Myr" - Sectional moment resultants at each node expressed in r r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N-m) +"Mzr" - Sectional moment resultants at each node expressed in r r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N-m) +"TDxr" - Sectional translational deflection (relative to the undeflected position) at each node expressed in r r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (m) +"TDyr" - Sectional translational deflection (relative to the undeflected position) at each node expressed in r r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (m) +"TDzr" - Sectional translational deflection (relative to the undeflected position) at each node expressed in r r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (m) +"RDxr" - Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) at each node expressed in r r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (-) +"RDyr" - Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) at each node expressed in r r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (-) +"RDzr" - Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) at each node expressed in r r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (-) +"AbsXg" - Node position in X (global coordinate) g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST’s global inertial frame (i) coordinate system (m) +"AbsYg" - Node position in Y (global coordinate) g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST’s global inertial frame (i) coordinate system (m) +"AbsZg" - Node position in Z (global coordinate) g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST’s global inertial frame (i) coordinate system (m) +"AbsXr" - Node position in X (relative to root) r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (m) +"AbsYr" - Node position in Y (relative to root) r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (m) +"AbsZr" - Node position in Z (relative to root) r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (m) +"TVxg" - Sectional translational velocities (absolute) g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST’s global inertial frame (i) coordinate system (m/s) +"TVyg" - Sectional translational velocities (absolute) g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST’s global inertial frame (i) coordinate system (m/s) +"TVzg" - Sectional translational velocities (absolute) g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST’s global inertial frame (i) coordinate system (m/s) +"TVxl" - Sectional translational velocities (absolute) l: a floating coordinate system local to the deflected beam (m/s) +"TVyl" - Sectional translational velocities (absolute) l: a floating coordinate system local to the deflected beam (m/s) +"TVzl" - Sectional translational velocities (absolute) l: a floating coordinate system local to the deflected beam (m/s) +"TVxr" - Sectional translational velocities (absolute) r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (m/s) +"TVyr" - Sectional translational velocities (absolute) r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (m/s) +"TVzr" - Sectional translational velocities (absolute) r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (m/s) +"RVxg" - Sectional angular/rotational velocities (absolute) g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST’s global inertial frame (i) coordinate system (deg/s) +"RVyg" - Sectional angular/rotational velocities (absolute) g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST’s global inertial frame (i) coordinate system (deg/s) +"RVzg" - Sectional angular/rotational velocities (absolute) g: the global inertial frame coordinate system; when coupled to FAST, this is equivalent to FAST’s global inertial frame (i) coordinate system (deg/s) +"RVxl" - Sectional angular/rotational velocities (absolute) l: a floating coordinate system local to the deflected beam (deg/s) +"RVyl" - Sectional angular/rotational velocities (absolute) l: a floating coordinate system local to the deflected beam (deg/s) +"RVzl" - Sectional angular/rotational velocities (absolute) l: a floating coordinate system local to the deflected beam (deg/s) +"RVxr" - Sectional angular/rotational velocities (absolute) r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (deg/s) +"RVyr" - Sectional angular/rotational velocities (absolute) r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (deg/s) +"RVzr" - Sectional angular/rotational velocities (absolute) r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (deg/s) +"TAxl" - Sectional angular/rotational velocities (absolute) l: a floating coordinate system local to the deflected beam (m/s^2) +"TAyl" - Sectional angular/rotational velocities (absolute) l: a floating coordinate system local to the deflected beam (m/s^2) +"TAzl" - Sectional angular/rotational velocities (absolute) l: a floating coordinate system local to the deflected beam (m/s^2) +"TAxr" - Sectional angular/rotational velocities (absolute) r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (m/s^2) +"TAyr" - Sectional angular/rotational velocities (absolute) r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (m/s^2) +"TAzr" - Sectional angular/rotational velocities (absolute) r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (m/s^2) +"RAxl" - Sectional angular/rotational velocities (absolute) l: a floating coordinate system local to the deflected beam (deg/s^2) +"RAyl" - Sectional angular/rotational velocities (absolute) l: a floating coordinate system local to the deflected beam (deg/s^2) +"RAzl" - Sectional angular/rotational velocities (absolute) l: a floating coordinate system local to the deflected beam (deg/s^2) +"RAxr" - Sectional angular/rotational velocities (absolute) r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (deg/s^2) +"RAyr" - Sectional angular/rotational velocities (absolute) r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (deg/s^2) +"RAzr" - Sectional angular/rotational velocities (absolute) r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (deg/s^2) +"PFxL" - Applied point forces at each node expressed in l l: a floating coordinate system local to the deflected beam (N) +"PFyL" - Applied point forces at each node expressed in l l: a floating coordinate system local to the deflected beam (N) +"PFzL" - Applied point forces at each node expressed in l l: a floating coordinate system local to the deflected beam (N) +"PMxL" - Applied point moments at each node expressed in l l: a floating coordinate system local to the deflected beam (N-m) +"PMyL" - Applied point moments at each node expressed in l l: a floating coordinate system local to the deflected beam (N-m) +"PMzL" - Applied point moments at each node expressed in l l: a floating coordinate system local to the deflected beam (N-m) +"DFxL" - Applied distributed forces at each node expressed in l l: a floating coordinate system local to the deflected beam (N/m) +"DFyL" - Applied distributed forces at each node expressed in l l: a floating coordinate system local to the deflected beam (N/m) +"DFzL" - Applied distributed forces at each node expressed in l l: a floating coordinate system local to the deflected beam (N/m) +"DMxL" - Applied distributed moments at each node expressed in l l: a floating coordinate system local to the deflected beam (N-m/m) +"DMyL" - Applied distributed moments at each node expressed in l l: a floating coordinate system local to the deflected beam (N-m/m) +"DMzL" - Applied distributed moments at each node expressed in l l: a floating coordinate system local to the deflected beam (N-m/m) +"DFxR" - Applied distributed forces at each node expressed in r r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N/m) +"DFyR" - Applied distributed forces at each node expressed in r r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N/m) +"DFzR" - Applied distributed forces at each node expressed in r r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N/m) +"DMxR" - Applied distributed forces at each node expressed in r r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N-m/m) +"DMyR" - Applied distributed forces at each node expressed in r r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N-m/m) +"DMzR" - Applied distributed forces at each node expressed in r r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N-m/m) +"FFbxl" - Gyroscopic force x l: a floating coordinate system local to the deflected beam (N) +"FFbyl" - Gyroscopic force y l: a floating coordinate system local to the deflected beam (N) +"FFbzl" - Gyroscopic force z l: a floating coordinate system local to the deflected beam (N) +"FFbxr" - Gyroscopic force x r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N) +"FFbyr" - Gyroscopic force y r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N) +"FFbzr" - Gyroscopic force z r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N) +"MFbxl" - Gyroscopic moment about x l: a floating coordinate system local to the deflected beam (N-m) +"MFbyl" - Gyroscopic moment about y l: a floating coordinate system local to the deflected beam (N-m) +"MFbzl" - Gyroscopic moment about z l: a floating coordinate system local to the deflected beam (N-m) +"MFbxr" - Gyroscopic moment about x r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N-m) +"MFbyr" - Gyroscopic moment about y r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N-m) +"MFbzr" - Gyroscopic moment about z r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N-m) +"FFcxl" - Elastic restoring force Fc x l: a floating coordinate system local to the deflected beam (N) +"FFcyl" - Elastic restoring force Fc y l: a floating coordinate system local to the deflected beam (N) +"FFczl" - Elastic restoring force Fc z l: a floating coordinate system local to the deflected beam (N) +"FFcxr" - Elastic restoring force Fc x r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N) +"FFcyr" - Elastic restoring force Fc y r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N) +"FFczr" - Elastic restoring force Fc z r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N) +"MFcxl" - Elastic restoring moment Fc about x l: a floating coordinate system local to the deflected beam (N-m) +"MFcyl" - Elastic restoring moment Fc about y l: a floating coordinate system local to the deflected beam (N-m) +"MFczl" - Elastic restoring moment Fc about z l: a floating coordinate system local to the deflected beam (N-m) +"MFcxr" - Elastic restoring moment Fc about x r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N-m) +"MFcyr" - Elastic restoring moment Fc about y r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N-m) +"MFczr" - Elastic restoring moment Fc about z r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N-m) +"FFdxl" - Elastic restoring force Fd x l: a floating coordinate system local to the deflected beam (N) +"FFdyl" - Elastic restoring force Fd y l: a floating coordinate system local to the deflected beam (N) +"FFdzl" - Elastic restoring force Fd z l: a floating coordinate system local to the deflected beam (N) +"FFdxr" - Elastic restoring force Fd x r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N) +"FFdyr" - Elastic restoring force Fd y r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N) +"FFdzr" - Elastic restoring force Fd z r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N) +"MFdxl" - Elastic restoring moment Fd about x l: a floating coordinate system local to the deflected beam (N-m) +"MFdyl" - Elastic restoring moment Fd about y l: a floating coordinate system local to the deflected beam (N-m) +"MFdzl" - Elastic restoring moment Fd about z l: a floating coordinate system local to the deflected beam (N-m) +"MFdxr" - Elastic restoring moment Fd about x r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N-m) +"MFdyr" - Elastic restoring moment Fd about y r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N-m) +"MFdzr" - Elastic restoring moment Fd about z r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N-m) +"FFgxl" - Gravity force x l: a floating coordinate system local to the deflected beam (N) +"FFgyl" - Gravity force y l: a floating coordinate system local to the deflected beam (N) +"FFgzl" - Gravity force z l: a floating coordinate system local to the deflected beam (N) +"FFgxr" - Gravity force x r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N) +"FFgyr" - Gravity force y r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N) +"FFgzr" - Gravity force z r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N) +"MFgxl" - Gravity moment about x l: a floating coordinate system local to the deflected beam (N-m) +"MFgyl" - Gravity moment about y l: a floating coordinate system local to the deflected beam (N-m) +"MFgzl" - Gravity moment about z l: a floating coordinate system local to the deflected beam (N-m) +"MFgxr" - Gravity moment about x r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N-m) +"MFgyr" - Gravity moment about y r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N-m) +"MFgzr" - Gravity moment about z r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N-m) +"FFixl" - Inertial force x l: a floating coordinate system local to the deflected beam (N) +"FFiyl" - Inertial force y l: a floating coordinate system local to the deflected beam (N) +"FFizl" - Inertial force z l: a floating coordinate system local to the deflected beam (N) +"FFixr" - Inertial force x r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N) +"FFiyr" - Inertial force y r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N) +"FFizr" - Inertial force z r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N) +"MFixl" - Inertial moment about x l: a floating coordinate system local to the deflected beam (N-m) +"MFiyl" - Inertial moment about y l: a floating coordinate system local to the deflected beam (N-m) +"MFizl" - Inertial moment about z l: a floating coordinate system local to the deflected beam (N-m) +"MFixr" - Inertial moment about x r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N-m) +"MFiyr" - Inertial moment about y r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N-m) +"MFizr" - Inertial moment about z r: a floating reference coordinate system fixed to the root of the moving beam; when coupled to FAST for blades, this is equivalent to the IEC blade (b) coordinate system (N-m) +END of input file (the word "END" must appear in the first 3 columns of this last OutList line) +--------------------------------------------------------------------------------------- diff --git a/docs/source/user/beamdyn/examples/bd_driver_dynamic_nrel_5mw.inp b/docs/source/user/beamdyn/examples/bd_driver_dynamic_nrel_5mw.inp index df2cca9641..4ce490dc66 100644 --- a/docs/source/user/beamdyn/examples/bd_driver_dynamic_nrel_5mw.inp +++ b/docs/source/user/beamdyn/examples/bd_driver_dynamic_nrel_5mw.inp @@ -14,14 +14,15 @@ True DynamicSolve - Dynamic solve (false for static solve) (-) 0 GlbPos(2) - Component of position vector of the reference blade frame along Y direction (m) 1 GlbPos(3) - Component of position vector of the reference blade frame along Z direction (m) ---The following 3 by 3 matrix is the direction cosine matirx ,GlbDCM(3,3), ----relates global frame to reference blade frame +---relates global frame to the initial blade root frame 1.0000000E+00 0.0000000E+00 0.0000000E+00 0.0000000E+00 1.0000000E+00 0.0000000E+00 0.0000000E+00 0.0000000E+00 1.0000000E+00 +True GlbRotBladeT0 - Reference orientation for BeamDyn calculations is aligned with initial blade root? ---------------------- ROOT VELOCITY PARAMETER ---------------------------------- - 1.0006 RootVel(4) - Component of angular velocity vector of the beam root about X axis (rad/s) - 0 RootVel(5) - Component of angular velocity vector of the beam root about Y axis (rad/s) - 0 RootVel(6) - Component of angular velocity vector of the beam root about Z axis (rad/s) + 1.0006 RootVel(4) - Component of angular velocity vector of the beam root about X axis (rad/s) + 0 RootVel(5) - Component of angular velocity vector of the beam root about Y axis (rad/s) + 0 RootVel(6) - Component of angular velocity vector of the beam root about Z axis (rad/s) ---------------------- APPLIED FORCE ---------------------------------- 0 DistrLoad(1) - Component of distributed force vector along X direction (N/m) 0 DistrLoad(2) - Component of distributed force vector along Y direction (N/m) @@ -39,5 +40,5 @@ True DynamicSolve - Dynamic solve (false for static solve) (-) Non-dim blade-span eta Fx Fy Fz Mx My Mz (-) (N) (N) (N) (N-m) (N-m) (N-m) ---------------------- PRIMARY INPUT FILE -------------------------------------- -"bd_primary_nrel_5mw_dynamic.inp" InputFile - Name of the primary BeamDyn input file +"bd_primary_nrel_5mw.inp" InputFile - Name of the primary BeamDyn input file diff --git a/docs/source/user/beamdyn/examples/bd_driver_static_nrel_5mw.inp b/docs/source/user/beamdyn/examples/bd_driver_static_nrel_5mw.inp index 080cc927dc..3986048ac2 100644 --- a/docs/source/user/beamdyn/examples/bd_driver_static_nrel_5mw.inp +++ b/docs/source/user/beamdyn/examples/bd_driver_static_nrel_5mw.inp @@ -14,14 +14,15 @@ False DynamicSolve - Dynamic solve (false for static solve) (-) 0 GlbPos(2) - Component of position vector of the reference blade frame along Y direction (m) 1 GlbPos(3) - Component of position vector of the reference blade frame along Z direction (m) ---The following 3 by 3 matrix is the direction cosine matirx ,GlbDCM(3,3), ----relates global frame to reference blade frame +---relates global frame to the initial blade root frame 1.0000000E+00 0.0000000E+00 0.0000000E+00 0.0000000E+00 1.0000000E+00 0.0000000E+00 0.0000000E+00 0.0000000E+00 1.0000000E+00 +True GlbRotBladeT0 - Reference orientation for BeamDyn calculations is aligned with initial blade root? ---------------------- ROOT VELOCITY PARAMETER ---------------------------------- - 0 RootVel(4) - Component of angular velocity vector of the beam root about X axis (rad/s) - 0 RootVel(5) - Component of angular velocity vector of the beam root about Y axis (rad/s) - 0 RootVel(6) - Component of angular velocity vector of the beam root about Z axis (rad/s) + 0 RootVel(4) - Component of angular velocity vector of the beam root about X axis (rad/s) + 0 RootVel(5) - Component of angular velocity vector of the beam root about Y axis (rad/s) + 0 RootVel(6) - Component of angular velocity vector of the beam root about Z axis (rad/s) ---------------------- APPLIED FORCE ---------------------------------- 10000 DistrLoad(1) - Component of distributed force vector along X direction (N/m) 0 DistrLoad(2) - Component of distributed force vector along Y direction (N/m) @@ -39,5 +40,5 @@ False DynamicSolve - Dynamic solve (false for static solve) (-) Non-dim blade-span eta Fx Fy Fz Mx My Mz (-) (N) (N) (N) (N-m) (N-m) (N-m) ---------------------- PRIMARY INPUT FILE -------------------------------------- -"bd_primary_nrel_5mw_static.inp" InputFile - Name of the primary BeamDyn input file +"bd_primary_nrel_5mw.inp" InputFile - Name of the primary BeamDyn input file diff --git a/docs/source/user/beamdyn/examples/bd_primary_nrel_5mw_dynamic.inp b/docs/source/user/beamdyn/examples/bd_primary_nrel_5mw.inp similarity index 87% rename from docs/source/user/beamdyn/examples/bd_primary_nrel_5mw_dynamic.inp rename to docs/source/user/beamdyn/examples/bd_primary_nrel_5mw.inp index 680db38b10..1fcd7475e1 100644 --- a/docs/source/user/beamdyn/examples/bd_primary_nrel_5mw_dynamic.inp +++ b/docs/source/user/beamdyn/examples/bd_primary_nrel_5mw.inp @@ -2,13 +2,13 @@ NREL 5MW blade primary input file ---------------------- SIMULATION CONTROL -------------------------------------- TRUE Echo - Echo input data to ".ech"? (flag) -False QuasiStaticInit - Use quasistatic pre-conditioning with centripetal accelerations in initialization? (flag) [dynamic solve only] +False QuasiStaticInit - Use quasi-static pre-conditioning with centripetal accelerations in initialization? (flag) [dynamic solve only] 0 rhoinf - Numerical damping parameter for generalized-alpha integrator 2 quadrature - Quadrature method: 1=Gaussian; 2=Trapezoidal (switch) "DEFAULT" refine - Refinement factor for trapezoidal quadrature (-) [DEFAULT = 1; used only when quadrature=2] "DEFAULT" n_fact - Factorization frequency for the Jacobian in N-R iteration(-) [DEFAULT = 5] "DEFAULT" DTBeam - Time step size (s) -"DEFAULT" load_retries - Number of factored load retries before quitting the aimulation [DEFAULT = 20] +"DEFAULT" load_retries - Number of factored load retries before quitting the simulation [DEFAULT = 20] "DEFAULT" NRMax - Max number of iterations in Newton-Raphson algorithm (-) [DEFAULT = 10] "DEFAULT" stop_tol - Tolerance for stopping criterion (-) [DEFAULT = 1E-5] FALSE tngt_stf_fd - Use finite differenced tangent stiffness matrix? (flag) @@ -92,5 +92,17 @@ True SumPrint - Print summary data to ".sum" (flag) "N1Mxl,N1Myl,N1Mzl" "TipTDxr, TipTDyr, TipTDzr" "TipRDxr, TipRDyr, TipRDzr" +END of input file (the word "END" must appear in the first 3 columns of the last OutList line) +====== Outputs for all blade stations (same ending as above for B1N1.... =========================== (optional section) + "All" BldNd_BlOutNd - Future feature will allow selecting a portion of the nodes to output. Not implemented yet. (-) + OutList - The next line(s) contains a list of output parameters. See OutListParameters.xlsx for a listing of available output channels, (-) +"TDxr, TDyr, TDzr" +"TVxr, TVyr, TVzr" +"TAxr, TAyr, TAzr" +"RDxr, RDyr, RDzr" +"RVxr, RVyr, RVzr" +"RAxr, RAyr, RAzr" +"Fxr, Fyr, Fzr" +"TipTDxr, TipTDyr, TipTDzr" +"TipRDxr, TipRDyr, TipRDzr" END of input file (the word "END" must appear in the first 3 columns of this last OutList line) ---------------------------------------------------------------------------------------- diff --git a/docs/source/user/beamdyn/examples/bd_primary_nrel_5mw_static.inp b/docs/source/user/beamdyn/examples/bd_primary_nrel_5mw_static.inp deleted file mode 100644 index 680db38b10..0000000000 --- a/docs/source/user/beamdyn/examples/bd_primary_nrel_5mw_static.inp +++ /dev/null @@ -1,96 +0,0 @@ ---------- BEAMDYN with OpenFAST INPUT FILE ------------------------------------------- -NREL 5MW blade primary input file ----------------------- SIMULATION CONTROL -------------------------------------- -TRUE Echo - Echo input data to ".ech"? (flag) -False QuasiStaticInit - Use quasistatic pre-conditioning with centripetal accelerations in initialization? (flag) [dynamic solve only] - 0 rhoinf - Numerical damping parameter for generalized-alpha integrator - 2 quadrature - Quadrature method: 1=Gaussian; 2=Trapezoidal (switch) -"DEFAULT" refine - Refinement factor for trapezoidal quadrature (-) [DEFAULT = 1; used only when quadrature=2] -"DEFAULT" n_fact - Factorization frequency for the Jacobian in N-R iteration(-) [DEFAULT = 5] -"DEFAULT" DTBeam - Time step size (s) -"DEFAULT" load_retries - Number of factored load retries before quitting the aimulation [DEFAULT = 20] -"DEFAULT" NRMax - Max number of iterations in Newton-Raphson algorithm (-) [DEFAULT = 10] -"DEFAULT" stop_tol - Tolerance for stopping criterion (-) [DEFAULT = 1E-5] -FALSE tngt_stf_fd - Use finite differenced tangent stiffness matrix? (flag) -FALSE tngt_stf_comp - Compare analytical finite differenced tangent stiffness matrix? (flag) -"DEFAULT" tngt_stf_pert - Perturbation size for finite differencing (-) [DEFAULT = 1E-6] -"DEFAULT" tngt_stf_difftol - Maximum allowable relative difference between analytical and fd tangent stiffness (-); [DEFAULT = 0.1] -True RotStates - Orient states in the rotating frame during linearization? (flag) [used only when linearizing] ----------------------- GEOMETRY PARAMETER -------------------------------------- - 1 member_total - Total number of members (-) - 49 kp_total - Total number of key points (-) [must be at least 3] - 1 49 - Member number; Number of key points in this member - kp_xr kp_yr kp_zr initial_twist - (m) (m) (m) (deg) -0.0000000E+00 0.0000000E+00 0.0000000E+00 1.3308000E+01 -0.0000000E+00 0.0000000E+00 1.9987500E-01 1.3308000E+01 -0.0000000E+00 0.0000000E+00 1.1998650E+00 1.3308000E+01 -0.0000000E+00 0.0000000E+00 2.1998550E+00 1.3308000E+01 -0.0000000E+00 0.0000000E+00 3.1998450E+00 1.3308000E+01 -0.0000000E+00 0.0000000E+00 4.1998350E+00 1.3308000E+01 -0.0000000E+00 0.0000000E+00 5.1998250E+00 1.3308000E+01 -0.0000000E+00 0.0000000E+00 6.1998150E+00 1.3308000E+01 -0.0000000E+00 0.0000000E+00 7.1998050E+00 1.3308000E+01 -0.0000000E+00 0.0000000E+00 8.2010250E+00 1.3308000E+01 -0.0000000E+00 0.0000000E+00 9.1997850E+00 1.3308000E+01 -0.0000000E+00 0.0000000E+00 1.0199775E+01 1.3308000E+01 -0.0000000E+00 0.0000000E+00 1.1199765E+01 1.3181000E+01 -0.0000000E+00 0.0000000E+00 1.2199755E+01 1.2848000E+01 -0.0000000E+00 0.0000000E+00 1.3200975E+01 1.2192000E+01 -0.0000000E+00 0.0000000E+00 1.4199735E+01 1.1561000E+01 -0.0000000E+00 0.0000000E+00 1.5199725E+01 1.1072000E+01 -0.0000000E+00 0.0000000E+00 1.6199715E+01 1.0792000E+01 -0.0000000E+00 0.0000000E+00 1.8200925E+01 1.0232000E+01 -0.0000000E+00 0.0000000E+00 2.0200290E+01 9.6720000E+00 -0.0000000E+00 0.0000000E+00 2.2200270E+01 9.1100000E+00 -0.0000000E+00 0.0000000E+00 2.4200250E+01 8.5340000E+00 -0.0000000E+00 0.0000000E+00 2.6200230E+01 7.9320000E+00 -0.0000000E+00 0.0000000E+00 2.8200825E+01 7.3210000E+00 -0.0000000E+00 0.0000000E+00 3.0200190E+01 6.7110000E+00 -0.0000000E+00 0.0000000E+00 3.2200170E+01 6.1220000E+00 -0.0000000E+00 0.0000000E+00 3.4200150E+01 5.5460000E+00 -0.0000000E+00 0.0000000E+00 3.6200130E+01 4.9710000E+00 -0.0000000E+00 0.0000000E+00 3.8200725E+01 4.4010000E+00 -0.0000000E+00 0.0000000E+00 4.0200090E+01 3.8340000E+00 -0.0000000E+00 0.0000000E+00 4.2200070E+01 3.3320000E+00 -0.0000000E+00 0.0000000E+00 4.4200050E+01 2.8900000E+00 -0.0000000E+00 0.0000000E+00 4.6200030E+01 2.5030000E+00 -0.0000000E+00 0.0000000E+00 4.8201240E+01 2.1160000E+00 -0.0000000E+00 0.0000000E+00 5.0199990E+01 1.7300000E+00 -0.0000000E+00 0.0000000E+00 5.2199970E+01 1.3420000E+00 -0.0000000E+00 0.0000000E+00 5.4199950E+01 9.5400000E-01 -0.0000000E+00 0.0000000E+00 5.5199940E+01 7.6000000E-01 -0.0000000E+00 0.0000000E+00 5.6199930E+01 5.7400000E-01 -0.0000000E+00 0.0000000E+00 5.7199920E+01 4.0400000E-01 -0.0000000E+00 0.0000000E+00 5.7699915E+01 3.1900000E-01 -0.0000000E+00 0.0000000E+00 5.8201140E+01 2.5300000E-01 -0.0000000E+00 0.0000000E+00 5.8699905E+01 2.1600000E-01 -0.0000000E+00 0.0000000E+00 5.9199900E+01 1.7800000E-01 -0.0000000E+00 0.0000000E+00 5.9699895E+01 1.4000000E-01 -0.0000000E+00 0.0000000E+00 6.0199890E+01 1.0100000E-01 -0.0000000E+00 0.0000000E+00 6.0699885E+01 6.2000000E-02 -0.0000000E+00 0.0000000E+00 6.1199880E+01 2.3000000E-02 -0.0000000E+00 0.0000000E+00 6.1500000E+01 0.0000000E+00 ----------------------- MESH PARAMETER ------------------------------------------ - 5 order_elem - Order of interpolation (basis) function (-) ----------------------- MATERIAL PARAMETER -------------------------------------- -"nrel_5mw_blade.inp" BldFile - Name of file containing properties for blade (quoted string) ----------------------- PITCH ACTUATOR PARAMETERS ------------------------------- -False UsePitchAct - Whether a pitch actuator should be used (flag) - 200 PitchJ - Pitch actuator inertia (kg-m^2) [used only when UsePitchAct is true] - 2E+07 PitchK - Pitch actuator stiffness (kg-m^2/s^2) [used only when UsePitchAct is true] - 500000 PitchC - Pitch actuator damping (kg-m^2/s) [used only when UsePitchAct is true] ----------------------- OUTPUTS ------------------------------------------------- -True SumPrint - Print summary data to ".sum" (flag) -"ES10.3E2" OutFmt - Format used for text tabular output, excluding the time channel. - 2 NNodeOuts - Number of nodes to output to file [0 - 9] (-) - 1, 3 OutNd - Nodes whose values will be output (-) - OutList - The next line(s) contains a list of output parameters. See OutListParameters.xlsx for a listing of available output channels, (-) -"RootFxr, RootFyr, RootFzr" -"RootMxr, RootMyr, RootMzr" -"N1Fxl,N1Fyl,N1Fzl" -"N1Mxl,N1Myl,N1Mzl" -"TipTDxr, TipTDyr, TipTDzr" -"TipRDxr, TipRDyr, TipRDzr" -END of input file (the word "END" must appear in the first 3 columns of this last OutList line) ---------------------------------------------------------------------------------------- diff --git a/docs/source/user/beamdyn/examples/nrel_5mw_blade.inp b/docs/source/user/beamdyn/examples/nrel_5mw_blade.inp index 2c5e66fcf5..24e2192f2a 100644 --- a/docs/source/user/beamdyn/examples/nrel_5mw_blade.inp +++ b/docs/source/user/beamdyn/examples/nrel_5mw_blade.inp @@ -6,7 +6,7 @@ ---------------------- DAMPING COEFFICIENT------------------------------------ mu1 mu2 mu3 mu4 mu5 mu6 (-) (-) (-) (-) (-) (-) -1.0E-03 1.0E-03 1.0E-03 0.0014 0.0022 0.0022 +1.0E-03 1.0E-03 1.0E-03 0.0014 0.0022 0.0022 ---------------------- DISTRIBUTED PROPERTIES--------------------------------- 0.000000 9.729480E+08 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 0.000000E+00 diff --git a/docs/source/user/beamdyn/input_files.rst b/docs/source/user/beamdyn/input_files.rst index d7bdc2fbdb..7e01003b18 100644 --- a/docs/source/user/beamdyn/input_files.rst +++ b/docs/source/user/beamdyn/input_files.rst @@ -415,6 +415,8 @@ actuator, whereby the pitch angular orientation, velocity, and acceleration are determined by the actuator based on the input blade-pitch angle prescribed by the driver code. +.. _BD-Outputs: + Outputs ~~~~~~~ @@ -461,6 +463,9 @@ remove the suspect channel from the output file. Please refer to Appendix :numref:`app-output-channel` for a complete list of possible output parameters and their names. + +.. include:: BDNodalOutputs.rst + Blade Input File ---------------- diff --git a/docs/source/user/elastodyn/EDNodalOutputs.rst b/docs/source/user/elastodyn/EDNodalOutputs.rst new file mode 100644 index 0000000000..12eb71f513 --- /dev/null +++ b/docs/source/user/elastodyn/EDNodalOutputs.rst @@ -0,0 +1,42 @@ +.. _ED-Nodal-Outputs: + +Nodal Outputs +~~~~~~~~~~~~~ + +In addition to the named outputs in :numref:`ED-Outputs` above, ElastoDyn allows +for outputting the full set blade node motions and loads (tower nodes +unavailable at present). Please refer to the ElastoDyn_Nodes tab in the +Excel file :download:`OutListParameters.xlsx <../../../OtherSupporting/OutListParameters.xlsx>` +for a complete list of possible output parameters. + +This section follows the `END` statement from normal Outputs section described +above, and includes a separator description line followed by the following +optinos. + +**BldNd_BladesOut** specifies the number of blades to output. Possible values +are 0 through the number of blades ElastoDyn is modeling. If the value is set to +1, only blade 1 will be output, and if the value is 2, blades 1 and 2 will be +output. + +**BldNd_BlOutNd** specifies which nodes to output. This is currently unused. + +The **OutList** section controls the nodal output quantities generated by +ElastoDyn. In this section, the user specifies the name of the channel family to +output. The output name for each channel is then created internally by ElastoDyn +by combining the blade number, node number, and channel family name. For +example, if the user specifies **TDx** as the channel family name, the output +channels will be named with the convention of **B**\ :math:`\mathbf{\beta}`\ +**N###TDx** where :math:`\mathbf{\beta}` is the blade number, and **###** is the +three digit node number. + + +Sample Nodal Outputs section +^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + +This sample includes the ``END`` statement from the regular outputs section. + +.. container:: + :name: File:EDNodalOutputs + + .. literalinclude:: exampleInput/NodalOutpus.txt + :linenos: diff --git a/docs/source/user/elastodyn/exampleInput/NodalOutpus.txt b/docs/source/user/elastodyn/exampleInput/NodalOutpus.txt new file mode 100644 index 0000000000..db15b8e793 --- /dev/null +++ b/docs/source/user/elastodyn/exampleInput/NodalOutpus.txt @@ -0,0 +1,26 @@ +END of input file (the word "END" must appear in the first 3 columns of this last OutList line) +---------------------- NODE OUTPUTS -------------------------------------------- + 3 BldNd_BladesOut - Blades to output + 99 BldNd_BlOutNd - Blade nodes on each blade (currently unused) + OutList - The next line(s) contains a list of output parameters. See OutListParameters.xlsx, ElastoDyn_Nodes tab for a listing of available output channels, (-) +"ALx" - local flapwise acceleration (absolute) of node +"ALy" - local flapwise acceleration (absolute) of node +"ALz" - local flapwise acceleration (absolute) of node +"TDx" - local flapwise (translational) deflection (relative to the undeflected position) of node +"TDy" - local edgewise (translational) deflection (relative to the undeflected position) of node +"TDz" - local axial (translational) deflection (relative to the undeflected position) of node +"RDx" - Local rotational displacement about x-axis (relative to undeflected) +"RDy" - Local rotational displacement about y-axis (relative to undeflected) +"RDz" - Local rotational displacement about z-axis (relative to undeflected) +"MLx" - local edgewise moment at node +"MLy" - local flapwise moment at node +"MLz" - local pitching moment at node +"FLx" - local flapwise shear force at node +"FLy" - local edgewise shear force at node +"FLz" - local axial force at node +"MLxNT" - Edgewise moment in local coordinate system (initial structural twist removed) +"MlyNT" - Flapwise shear moment in local coordinate system (initial structural twist removed) +"FLxNT" - Flapwise shear force in local coordinate system (initial structural twist removed) +"FlyNT" - Edgewise shear force in local coordinate system (initial structural twist removed) +END of input file (the word "END" must appear in the first 3 columns of this last OutList line) +--------------------------------------------------------------------------------------- diff --git a/docs/source/user/elastodyn/index.rst b/docs/source/user/elastodyn/index.rst new file mode 100644 index 0000000000..d3ef2bdb8c --- /dev/null +++ b/docs/source/user/elastodyn/index.rst @@ -0,0 +1,18 @@ +ElastoDyn Users Guide and Theory Manual +======================================= + +.. only:: html + + This document offers a quick reference guide for the ElastoDyn software + program. It is intended to be used by the general user in combination + with other OpenFAST manuals. The manual will be updated as new releases are + issued and as needed to provide further information on advancements or + modifications to the software. + + The documentation here is incomplete. + + +.. toctree:: + + input.rst + diff --git a/docs/source/user/elastodyn/input.rst b/docs/source/user/elastodyn/input.rst new file mode 100644 index 0000000000..8fa4c66633 --- /dev/null +++ b/docs/source/user/elastodyn/input.rst @@ -0,0 +1,364 @@ +.. _ed_input: + +Input Files +=========== + +The user configures the structural model parameters via a primary ElastoDyn +input file, as well as separate input files for the tower and *other stuff that +will be documented here later.* + +No lines should be added or removed from the input files. + +Units +----- + +ElastoDyn uses the SI system (kg, m, s, N). Angles are assumed to be in +radians unless otherwise specified. + +ElastoDyn Primary Input File +---------------------------- + +The primary ElastoDyn input file defines modeling options and geometries for the +OpenFAST structure including the tower, nacelle, drivetrain, and blades (if +BeamDyn is not used). It also sets the initial conditions for the structure. + +Simulation Control +~~~~~~~~~~~~~~~~~~ + +Set the **Echo** flag to TRUE if you wish to have ElastoDyn echo the +contents of the ElastoDyn primary, airfoil, and blade input files (useful +for debugging errors in the input files). The echo file has the naming +convention of *OutRootFile.ED.ech*. **OutRootFile** is either +specified in the I/O SETTINGS section of the driver input file when +running ElastoDyn standalone, or by the OpenFAST program when running a +coupled simulation. + +**Method** + +**dT** + +Environmental Condition +~~~~~~~~~~~~~~~~~~~~~~~ + +**gravity** + +Degrees of Freedom +~~~~~~~~~~~~~~~~~~ + +**FlapDOF1** - First flapwise blade mode DOF (flag) + +**FlapDOF2** - Second flapwise blade mode DOF (flag) + +**EdgeDOF** - First edgewise blade mode DOF (flag) + +**TeetDOF** - Rotor-teeter DOF (flag) [unused for 3 blades] + +**DrTrDOF** - Drivetrain rotational-flexibility DOF (flag) + +**GenDOF** - Generator DOF (flag) + +**YawDOF** - Yaw DOF (flag) + +**TwFADOF1** - First fore-aft tower bending-mode DOF (flag) + +**TwFADOF2** - Second fore-aft tower bending-mode DOF (flag) + +**TwSSDOF1** - First side-to-side tower bending-mode DOF (flag) + +**TwSSDOF2** - Second side-to-side tower bending-mode DOF (flag) + +**PtfmSgDOF** - Platform horizontal surge translation DOF (flag) + +**PtfmSwDOF** - Platform horizontal sway translation DOF (flag) + +**PtfmHvDOF** - Platform vertical heave translation DOF (flag) + +**PtfmRDOF** - Platform roll tilt rotation DOF (flag) + +**PtfmPDOF** - Platform pitch tilt rotation DOF (flag) + +**PtfmYDOF** - Platform yaw rotation DOF (flag) + + + +Initial Conditions +~~~~~~~~~~~~~~~~~~ + +**OoPDefl** - Initial out-of-plane blade-tip displacement (meters) + +**IPDefl** - Initial in-plane blade-tip deflection (meters) + +**BlPitch(1)** - Blade 1 initial pitch (degrees) + +**BlPitch(2)** - Blade 2 initial pitch (degrees) + +**BlPitch(3)** - Blade 3 initial pitch (degrees) [unused for 2 blades] + +**TeetDefl** - Initial or fixed teeter angle (degrees) [unused for 3 blades] + +**Azimuth** - Initial azimuth angle for blade 1 (degrees) + +**RotSpeed** - Initial or fixed rotor speed (rpm) + +**NacYaw** - Initial or fixed nacelle-yaw angle (degrees) + +**TTDspFA** - Initial fore-aft tower-top displacement (meters) + +**TTDspSS** - Initial side-to-side tower-top displacement (meters) + +**PtfmSurge** - Initial or fixed horizontal surge translational displacement of platform (meters) + +**PtfmSway** - Initial or fixed horizontal sway translational displacement of platform (meters) + +**PtfmHeave** - Initial or fixed vertical heave translational displacement of platform (meters) + +**PtfmRoll** - Initial or fixed roll tilt rotational displacement of platform (degrees) + +**PtfmPitch** - Initial or fixed pitch tilt rotational displacement of platform (degrees) + +**PtfmYaw** - Initial or fixed yaw rotational displacement of platform (degrees) + +Turbine Configuration +~~~~~~~~~~~~~~~~~~~~~ + +**NumBl** - Number of blades (-) + +**TipRad** - The distance from the rotor apex to the blade tip (meters) + +**HubRad** - The distance from the rotor apex to the blade root (meters) + +**PreCone(1)** - Blade 1 cone angle (degrees) + +**PreCone(2)** - Blade 2 cone angle (degrees) + +**PreCone(3)** - Blade 3 cone angle (degrees) [unused for 2 blades] + +**HubCM** - Distance from rotor apex to hub mass [positive downwind] (meters) + +**UndSling** - Undersling length [distance from teeter pin to the rotor apex] (meters) [unused for 3 blades] + +**Delta3** - Delta-3 angle for teetering rotors (degrees) [unused for 3 blades] + +**AzimB1Up** - Azimuth value to use for I/O when blade 1 points up (degrees) + +**OverHang** - Distance from yaw axis to rotor apex [3 blades] or teeter pin [2 blades] (meters) + +**ShftGagL** - Distance from rotor apex [3 blades] or teeter pin [2 blades] to shaft strain gages [positive for upwind rotors] (meters) + +**ShftTilt** - Rotor shaft tilt angle (degrees) + +**NacCMxn** - Downwind distance from the tower-top to the nacelle CM (meters) + +**NacCMyn** - Lateral distance from the tower-top to the nacelle CM (meters) + +**NacCMzn** - Vertical distance from the tower-top to the nacelle CM (meters) + +**NcIMUxn** - Downwind distance from the tower-top to the nacelle IMU (meters) + +**NcIMUyn** - Lateral distance from the tower-top to the nacelle IMU (meters) + +**NcIMUzn** - Vertical distance from the tower-top to the nacelle IMU (meters) + +**Twr2Shft** - Vertical distance from the tower-top to the rotor shaft (meters) + +**TowerHt** - Height of tower above ground level [onshore] or MSL [offshore] (meters) + +**TowerBsHt** - Height of tower base above ground level [onshore] or MSL [offshore] (meters) + +**PtfmCMxt** - Downwind distance from the ground level [onshore] or MSL [offshore] to the platform CM (meters) + +**PtfmCMyt** - Lateral distance from the ground level [onshore] or MSL [offshore] to the platform CM (meters) + +**PtfmCMzt** - Vertical distance from the ground level [onshore] or MSL [offshore] to the platform CM (meters) + +**PtfmRefzt** - Vertical distance from the ground level [onshore] or MSL [offshore] to the platform reference point (meters) + + + +Mass and Inertia +~~~~~~~~~~~~~~~~ + +**TipMass(1)** - Tip-brake mass, blade 1 (kg) + +**TipMass(2)** - Tip-brake mass, blade 2 (kg) + +**TipMass(3)** - Tip-brake mass, blade 3 (kg) [unused for 2 blades] + +**HubMass** - Hub mass (kg) + +**HubIner** - Hub inertia about rotor axis [3 blades] or teeter axis [2 blades] (kg m^2) + +**GenIner** - Generator inertia about HSS (kg m^2) + +**NacMass** - Nacelle mass (kg) + +**NacYIner** - Nacelle inertia about yaw axis (kg m^2) + +**YawBrMass** - Yaw bearing mass (kg) + +**PtfmMass** - Platform mass (kg) + +**PtfmRIner** - Platform inertia for roll tilt rotation about the platform CM (kg m^2) + +**PtfmPIner** - Platform inertia for pitch tilt rotation about the platform CM (kg m^2) + +**PtfmYIner** - Platform inertia for yaw rotation about the platform CM (kg m^2) + + + +Blade +~~~~~ + +**BldNodes** - Number of blade nodes (per blade) used for analysis (-) + +**BldFile(1)** - Name of file containing properties for blade 1 (quoted string) + +**BldFile(2)** - Name of file containing properties for blade 2 (quoted string) + +**BldFile(3)** - Name of file containing properties for blade 3 (quoted string) [unused for 2 blades] + + +Rotor-Teeter +~~~~~~~~~~~~ + +**TeetMod** - Rotor-teeter spring/damper model {0: none, 1: standard, 2: user-defined from routine UserTeet} (switch) [unused for 3 blades] + +**TeetDmpP** - Rotor-teeter damper position (degrees) [used only for 2 blades and when TeetMod=1] + +**TeetDmp** - Rotor-teeter damping constant (N-m/(rad/s)) [used only for 2 blades and when TeetMod=1] + +**TeetCDmp** - Rotor-teeter rate-independent Coulomb-damping moment (N-m) [used only for 2 blades and when TeetMod=1] + +**TeetSStP** - Rotor-teeter soft-stop position (degrees) [used only for 2 blades and when TeetMod=1] + +**TeetHStP** - Rotor-teeter hard-stop position (degrees) [used only for 2 blades and when TeetMod=1] + +**TeetSSSp** - Rotor-teeter soft-stop linear-spring constant (N-m/rad) [used only for 2 blades and when TeetMod=1] + +**TeetHSSp** - Rotor-teeter hard-stop linear-spring constant (N-m/rad) [used only for 2 blades and when TeetMod=1] + + + +Drivetrain +~~~~~~~~~~ + +**GBoxEff** - Gearbox efficiency (%) + +**GBRatio** - Gearbox ratio (-) + +**DTTorSpr** - Drivetrain torsional spring (N-m/rad) + +**DTTorDmp** - Drivetrain torsional damper (N-m/(rad/s)) + + + +Furling +~~~~~~~ + +**Furling** - Read in additional model properties for furling turbine (flag) [must currently be FALSE) + +**FurlFile** - Name of file containing furling properties (quoted string) [unused when Furling=False] + + +Tower +~~~~~ + +**TwrNodes** - Number of tower nodes used for analysis (-) + +**TwrFile** - Name of file containing tower properties (quoted string) + + +.. _ED-Outputs: + +Outputs +~~~~~~~ + +**SumPrint** [flag] Set this value to TRUE if you want ElastoDyn to generate a +summary file with the name **OutFileRoot**.ED.sum*. **OutFileRoot** is specified +by the OpenFAST program when running a coupled simulation. + +**OutFile** [switch] is currently unused. The eventual purpose is to allow +output from ElastoDyn to be written to a module output file (option 1), or the +main OpenFAST output file (option 2), or both. At present this switch is +ignored. + +**TabDelim** [flag] is currently unused. Setting this to True will set the +delimeter for text files to the tab character for the ElastoDyn module +**OutFile**. + +**OutFmt** [quoted string] is currently unused. ElastoDyn will use this string +as the numerical format specifier for output of floating-point values in its +local output specified by **OutFile**. The length of this string must not exceed +20 characters and must be enclosed in apostrophes or double quotes. You may not +specify an empty string. To ensure that fixed-width column data align properly +with the column titles, you should ensure that the width of the field is 10 +characters. Using an E, EN, or ES specifier will guarantee that you will never +overflow the field because the number is too big, but such numbers are harder to +read. Using an F specifier will give you numbers that are easier to read, but +you may overflow the field. Please refer to any Fortran manual for details for +format specifiers. + +**TStart** [s] sets the start time for **OutFile**. This is currenlty unused. + +**DecFact** [-] This parameter sets the decimation factor for output. ElastoDyn +will output data to **OutFile** only once each DecFact integration time steps. +For instance, a value of 5 will cause FAST to generate output only every fifth +time step. This value must be an integer greater than zero. + +**NTwGages** [-] The number of strain-gage locations along the tower indicates +the number of input values on the next line. Valid values are integers from 0 to +5 (inclusive). + +**TwrGagNd** [-] The virtual strain-gage locations along the tower are assigned +to the tower analysis nodes specified on this line. Possible values are 1 to +TwrNodes (inclusive), where 1 corresponds to the node closest to the tower base +(but not at the base) and a value of TwrNodes corresponds to the node closest to +the tower top. The exact elevations of each analysis node in the undeflected +tower, relative to the base of the tower, are determined as follows: + + Elev. of node J = TwrRBHt + ( J – 1⁄2 ) • [ ( TowerHt + TwrDraft – TwrRBHt ) / TwrNodes ] + (for J = 1,2,...,TwrNodes) + +You must enter at least NTwGages values on this line. +If NTwGages is 0, this line will be skipped, but you must have a line taking up +space in the input file. You can separate the values with combinations of tabs, +spaces, and commas, but you may use only one comma between numbers. + +**NBlGages** [-] specifies the number of strain-gague locations along the blade, +and indicates the number of input values expected in **BldGagNd**. This is only +used when the blade structure is modeled in ElastoDyn. + +**BldGagNd** [-] specifies the virtual strain-gage locations along the blade +that should be output. Possible values are 1 to **BldNodes** (inclusive), where +1 corresponds to the node closest to the blade root (but not at the root) and a +value of BldNodes corresponds to the node closest to the blade tip. The node +locations are specified by the ElastoDyn blade input files. You must enter at +least NBlGages values on this line. If NBlGages is 0, this line will be skipped, +but you must have a line taking up space in the input file. You can separate the +values with combinations of tabs, spaces, and commas, but you may use only one +comma between numbers. This is only used when the blade structure is modeled in +ElastoDyn. + + +The **OutList** section controls output quantities generated by +ElastoDyn. Enter one or more lines containing quoted strings that in turn +contain one or more output parameter names. Separate output parameter +names by any combination of commas, semicolons, spaces, and/or tabs. If +you prefix a parameter name with a minus sign, “-”, underscore, “_”, or +the characters “m” or “M”, ElastoDyn will multiply the value for that +channel by –1 before writing the data. The parameters are written in the +order they are listed in the input file. ElastoDyn allows you to use +multiple lines so that you can break your list into meaningful groups +and so the lines can be shorter. You may enter comments after the +closing quote on any of the lines. Entering a line with the string “END” +at the beginning of the line or at the beginning of a quoted string +found at the beginning of the line will cause ElastoDyn to quit scanning +for more lines of channel names. Blade and tower node-related quantities +are generated for the requested nodes identified through the +**BldGagNd** and **TwrGagNd** lists above. If ElastoDyn encounters an +unknown/invalid channel name, it warns the users but will remove the +suspect channel from the output file. Please refer to the ElastoDyn tab in the +Excel file :download:`OutListParameters.xlsx <../../../OtherSupporting/OutListParameters.xlsx>` +for a complete list of possible output parameters. + +.. include:: EDNodalOutputs.rst diff --git a/docs/source/user/index.rst b/docs/source/user/index.rst index 125a16da8e..fe619b8749 100644 --- a/docs/source/user/index.rst +++ b/docs/source/user/index.rst @@ -15,6 +15,7 @@ Details on the transition from FAST v8 to OpenFAST may be found in :numref:`fast api_change.rst aerodyn/index.rst beamdyn/index.rst + elastodyn/index.rst fast_to_openfast.rst cppapi/index.rst diff --git a/glue-codes/openfast/src/FAST_Prog.f90 b/glue-codes/openfast/src/FAST_Prog.f90 index 8dbb76dedd..990b6b4964 100644 --- a/glue-codes/openfast/src/FAST_Prog.f90 +++ b/glue-codes/openfast/src/FAST_Prog.f90 @@ -37,7 +37,7 @@ PROGRAM FAST ! Local parameters: REAL(DbKi), PARAMETER :: t_initial = 0.0_DbKi ! Initial time -INTEGER(IntKi), PARAMETER :: NumTurbines = 1 +INTEGER(IntKi), PARAMETER :: NumTurbines = 1 ! Note that CalcSteady linearization analysis and WrVTK_Modes should be performed with only 1 turbine ! Other/Misc variables TYPE(FAST_TurbineType) :: Turbine(NumTurbines) ! Data for each turbine instance @@ -45,7 +45,7 @@ PROGRAM FAST INTEGER(IntKi) :: i_turb ! current turbine number INTEGER(IntKi) :: n_t_global ! simulation time step, loop counter for global (FAST) simulation INTEGER(IntKi) :: ErrStat ! Error status -CHARACTER(1024) :: ErrMsg ! Error message +CHARACTER(ErrMsgLen) :: ErrMsg ! Error message ! data for restart: CHARACTER(1000) :: InputFile ! String to hold the intput file name @@ -53,6 +53,7 @@ PROGRAM FAST CHARACTER(20) :: FlagArg ! flag argument from command line INTEGER(IntKi) :: Restart_step ! step to start on (for restart) + !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ! determine if this is a restart from checkpoint !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ @@ -65,11 +66,20 @@ PROGRAM FAST IF ( TRIM(FlagArg) == 'RESTART' ) THEN ! Restart from checkpoint file CALL FAST_RestoreFromCheckpoint_Tary(t_initial, Restart_step, Turbine, CheckpointRoot, ErrStat, ErrMsg ) - CALL CheckError( ErrStat, ErrMsg, 'during restore from checkpoint' ) + CALL CheckError( ErrStat, ErrMsg, 'during restore from checkpoint' ) + + ELSE IF ( TRIM(FlagArg) == 'VTKLIN' ) THEN ! Read checkpoint file to output linearization analysis, but don't continue time-marching + CALL FAST_RestoreForVTKModeShape_Tary(t_initial, Turbine, CheckpointRoot, ErrStat, ErrMsg ) + CALL CheckError( ErrStat, ErrMsg, 'during restore from checkpoint for mode shapes' ) + ! Note that this works only when NumTurbines==1 (we don't have files for each of the turbines...) + Restart_step = Turbine(1)%p_FAST%n_TMax_m1 + 1 + CALL ExitThisProgram_T( Turbine(1), ErrID_None, .true., SkipRunTimeMsg = .TRUE. ) + ELSEIF ( LEN( TRIM(FlagArg) ) > 0 ) THEN ! Any other flag, end normally CALL NormStop() + ELSE Restart_step = 0 @@ -109,13 +119,13 @@ PROGRAM FAST ! Time Stepping: !............................................................................................................................... - DO n_t_global = Restart_step, Turbine(1)%p_FAST%n_TMax_m1 +TIME_STEP_LOOP: DO n_t_global = Restart_step, Turbine(1)%p_FAST%n_TMax_m1 ! bjj: we have to make sure the n_TMax_m1 and n_ChkptTime are the same for all turbines or have some different logic here ! write checkpoint file if requested - IF (mod(n_t_global, Turbine(1)%p_FAST%n_ChkptTime) == 0 .AND. Restart_step /= n_t_global) then + IF (mod(n_t_global, Turbine(1)%p_FAST%n_ChkptTime) == 0 .AND. Restart_step /= n_t_global .and. .not. Turbine(1)%m_FAST%Lin%FoundSteady) then CheckpointRoot = TRIM(Turbine(1)%p_FAST%OutFileRoot)//'.'//TRIM(Num2LStr(n_t_global)) CALL FAST_CreateCheckpoint_Tary(t_initial, n_t_global, Turbine, CheckpointRoot, ErrStat, ErrMsg) @@ -129,7 +139,7 @@ PROGRAM FAST ! this takes data from n_t_global and gets values at n_t_global + 1 DO i_turb = 1,NumTurbines - + CALL FAST_Solution_T( t_initial, n_t_global, Turbine(i_turb), ErrStat, ErrMsg ) CALL CheckError( ErrStat, ErrMsg ) @@ -139,12 +149,16 @@ PROGRAM FAST CALL FAST_Linearize_T(t_initial, n_t_global+1, Turbine(i_turb), ErrStat, ErrMsg) CALL CheckError( ErrStat, ErrMsg ) + IF ( Turbine(i_turb)%m_FAST%Lin%FoundSteady) EXIT TIME_STEP_LOOP END DO - - - END DO ! n_t_global + END DO TIME_STEP_LOOP ! n_t_global + DO i_turb = 1,NumTurbines + if ( Turbine(i_turb)%p_FAST%CalcSteady .and. .not. Turbine(i_turb)%m_FAST%Lin%FoundSteady) then + CALL CheckError( ErrID_Fatal, "Unable to find steady-state solution." ) + end if + END DO !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ! Write simulation times and stop diff --git a/glue-codes/simulink/src/create_FAST_SFunc.m b/glue-codes/simulink/src/create_FAST_SFunc.m index 4c52505fba..f97fb2b41e 100644 --- a/glue-codes/simulink/src/create_FAST_SFunc.m +++ b/glue-codes/simulink/src/create_FAST_SFunc.m @@ -1,7 +1,7 @@ %% INSTRUCTIONS % Before running this script, you must have compiled OpenFAST for Simulink to create a DLL (i.e., a shared library like .so, .dylib, .lib, etc.). % - If cmake was used, make sure the install directory is specified properly in the `installDir` variable below, -% and set `built_with_visualStudio` to false (necessary on Windows only). +% and if using Windows, set `built_with_visualStudio` to false. % - If the Visual Studio Solution file contained in the vs-build directory was used to create the DLL on Windows, % make sure `built_with_visualStudio` is set to true. % - The name of the library that was generated must match the `libname` variable below diff --git a/modules/aerodyn/CMakeLists.txt b/modules/aerodyn/CMakeLists.txt index db590322c8..ea3acc5ce0 100644 --- a/modules/aerodyn/CMakeLists.txt +++ b/modules/aerodyn/CMakeLists.txt @@ -27,6 +27,7 @@ endif() set(AD_LIBS_SOURCES src/AeroDyn.f90 src/AeroDyn_IO.f90 + src/AeroDyn_AllBldNdOuts_IO.f90 src/AirfoilInfo.f90 src/BEMT.f90 src/DBEMT.f90 diff --git a/modules/aerodyn/src/AeroDyn.f90 b/modules/aerodyn/src/AeroDyn.f90 index 5519cdb567..6e19482989 100644 --- a/modules/aerodyn/src/AeroDyn.f90 +++ b/modules/aerodyn/src/AeroDyn.f90 @@ -1,7 +1,7 @@ !********************************************************************************************************************************** ! LICENSING ! Copyright (C) 2015-2016 National Renewable Energy Laboratory -! Copyright (C) 2016-2018 Envision Energy USA, LTD +! Copyright (C) 2016-2019 Envision Energy USA, LTD ! ! This file is part of AeroDyn. ! @@ -82,93 +82,31 @@ subroutine AD_SetInitOut(p, InputFileData, InitOut, errStat, errMsg) integer(IntKi) :: i, j, k, f integer(IntKi) :: NumCoords -#ifdef DBG_OUTS - integer(IntKi) :: m - character(6) ::chanPrefix - character(3) :: TmpChar -#endif ! Initialize variables for this routine errStat = ErrID_None errMsg = "" InitOut%AirDens = p%AirDens - - call AllocAry( InitOut%WriteOutputHdr, p%numOuts, 'WriteOutputHdr', errStat2, errMsg2 ) + + call AllocAry( InitOut%WriteOutputHdr, p%numOuts + p%BldNd_TotNumOuts, 'WriteOutputHdr', errStat2, errMsg2 ) call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - call AllocAry( InitOut%WriteOutputUnt, p%numOuts, 'WriteOutputUnt', errStat2, errMsg2 ) + call AllocAry( InitOut%WriteOutputUnt, p%numOuts + p%BldNd_TotNumOuts, 'WriteOutputUnt', errStat2, errMsg2 ) call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) if (ErrStat >= AbortErrLev) return -#ifdef DBG_OUTS - ! Loop over blades and nodes to populate the output channel names and units - - do k=1,p%numBlades - do j=1, p%NumBlNds - - m = (k-1)*p%NumBlNds*23 + (j-1)*23 - - WRITE (TmpChar,'(I3.3)') j - chanPrefix = "B"//trim(num2lstr(k))//"N"//TmpChar - InitOut%WriteOutputHdr( m + 1 ) = trim(chanPrefix)//"Twst" - InitOut%WriteOutputUnt( m + 1 ) = ' (deg) ' - InitOut%WriteOutputHdr( m + 2 ) = trim(chanPrefix)//"Psi" - InitOut%WriteOutputUnt( m + 2 ) = ' (deg) ' - InitOut%WriteOutputHdr( m + 3 ) = trim(chanPrefix)//"Vx" - InitOut%WriteOutputUnt( m + 3 ) = ' (m/s) ' - InitOut%WriteOutputHdr( m + 4 ) = trim(chanPrefix)//"Vy" - InitOut%WriteOutputUnt( m + 4 ) = ' (m/s) ' - InitOut%WriteOutputHdr( m + 5 ) = ' '//trim(chanPrefix)//"AIn" - InitOut%WriteOutputUnt( m + 5 ) = ' (-) ' - InitOut%WriteOutputHdr( m + 6 ) = ' '//trim(chanPrefix)//"ApIn" - InitOut%WriteOutputUnt( m + 6 ) = ' (-) ' - InitOut%WriteOutputHdr( m + 7 ) = trim(chanPrefix)//"Vrel" - InitOut%WriteOutputUnt( m + 7 ) = ' (m/s) ' - InitOut%WriteOutputHdr( m + 8 ) = ' '//trim(chanPrefix)//"Phi" - InitOut%WriteOutputUnt( m + 8 ) = ' (deg) ' - InitOut%WriteOutputHdr( m + 9 ) = ' '//trim(chanPrefix)//"AOA" - InitOut%WriteOutputUnt( m + 9 ) = ' (deg) ' - InitOut%WriteOutputHdr( m + 10 ) = ' '//trim(chanPrefix)//"Cl" - InitOut%WriteOutputUnt( m + 10 ) = ' (-) ' - InitOut%WriteOutputHdr( m + 11 ) = ' '//trim(chanPrefix)//"Cd" - InitOut%WriteOutputUnt( m + 11 ) = ' (-) ' - InitOut%WriteOutputHdr( m + 12 ) = ' '//trim(chanPrefix)//"Cm" - InitOut%WriteOutputUnt( m + 12 ) = ' (-) ' - InitOut%WriteOutputHdr( m + 13 ) = ' '//trim(chanPrefix)//"Cx" - InitOut%WriteOutputUnt( m + 13 ) = ' (-) ' - InitOut%WriteOutputHdr( m + 14 ) = ' '//trim(chanPrefix)//"Cy" - InitOut%WriteOutputUnt( m + 14 ) = ' (-) ' - InitOut%WriteOutputHdr( m + 15 ) = ' '//trim(chanPrefix)//"Cn" - InitOut%WriteOutputUnt( m + 15 ) = ' (-) ' - InitOut%WriteOutputHdr( m + 16 ) = ' '//trim(chanPrefix)//"Ct" - InitOut%WriteOutputUnt( m + 16 ) = ' (-) ' - InitOut%WriteOutputHdr( m + 17 ) = ' '//trim(chanPrefix)//"Fl" - InitOut%WriteOutputUnt( m + 17 ) = ' (N/m) ' - InitOut%WriteOutputHdr( m + 18 ) = ' '//trim(chanPrefix)//"Fd" - InitOut%WriteOutputUnt( m + 18 ) = ' (N/m) ' - InitOut%WriteOutputHdr( m + 19 ) = ' '//trim(chanPrefix)//"M" - InitOut%WriteOutputUnt( m + 19 ) = ' (N/m^2) ' - InitOut%WriteOutputHdr( m + 20 ) = ' '//trim(chanPrefix)//"Fx" - InitOut%WriteOutputUnt( m + 20 ) = ' (N/m) ' - InitOut%WriteOutputHdr( m + 21 ) = ' '//trim(chanPrefix)//"Fy" - InitOut%WriteOutputUnt( m + 21 ) = ' (N/m) ' - InitOut%WriteOutputHdr( m + 22 ) = ' '//trim(chanPrefix)//"Fn" - InitOut%WriteOutputUnt( m + 22 ) = ' (N/m) ' - InitOut%WriteOutputHdr( m + 23 ) = ' '//trim(chanPrefix)//"Ft" - InitOut%WriteOutputUnt( m + 23 ) = ' (N/m) ' - - end do - end do -#else do i=1,p%NumOuts InitOut%WriteOutputHdr(i) = p%OutParam(i)%Name InitOut%WriteOutputUnt(i) = p%OutParam(i)%Units end do -#endif - + + + ! Set the info in WriteOutputHdr and WriteOutputUnt + CALL AllBldNdOuts_InitOut( InitOut, p, InputFileData, ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) InitOut%Ver = AD_Ver @@ -432,7 +370,14 @@ subroutine AD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) end if - + !............................................................................................ + ! If you want to choose your own rate instead of using what the glue code suggests, tell the glue code the rate at which + ! this module must be called here: + !............................................................................................ + + Interval = p%DT + + call Cleanup() contains @@ -513,11 +458,7 @@ subroutine Init_MiscVars(m, p, u, y, errStat, errMsg) m%SigmaCavitCrit = 0.0_ReKi m%CavitWarnSet = .false. ! arrays for output -#ifdef DBG_OUTS - allocate( m%AllOuts(0:p%NumOuts), STAT=ErrStat2 ) ! allocate starting at zero to account for invalid output channels -#else allocate( m%AllOuts(0:MaxOutPts), STAT=ErrStat2 ) ! allocate starting at zero to account for invalid output channels -#endif if (ErrStat2 /= 0) then call SetErrStat( ErrID_Fatal, "Error allocating AllOuts.", errStat, errMsg, RoutineName ) return @@ -644,8 +585,8 @@ subroutine Init_y(y, u, p, errStat, errMsg) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) end do - - call AllocAry( y%WriteOutput, p%numOuts, 'WriteOutput', errStat2, errMsg2 ) + + call AllocAry( y%WriteOutput, p%numOuts + p%BldNd_TotNumOuts, 'WriteOutput', errStat2, errMsg2 ) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) if (ErrStat >= AbortErrLev) RETURN @@ -953,12 +894,6 @@ subroutine SetParameters( InitInp, InputFileData, p, ErrStat, ErrMsg ) !p%RootName = TRIM(InitInp%RootName)//'.AD' ! set earlier to it could be used -#ifdef DBG_OUTS - p%NBlOuts = 23 - p%numOuts = p%NumBlNds*p%NumBlades*p%NBlOuts - p%NTwOuts = 0 - -#else p%numOuts = InputFileData%NumOuts p%NBlOuts = InputFileData%NBlOuts p%BlOutNd = InputFileData%BlOutNd @@ -974,7 +909,15 @@ subroutine SetParameters( InitInp, InputFileData, p, ErrStat, ErrMsg ) call setErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) if (ErrStat >= AbortErrLev) return -#endif + + + + ! Set the nodal output parameters. Note there is some validation in this, so we might get an error from here. + CALL AllBldNdOuts_SetParameters( InitInp, InputFileData, p, ErrStat2, ErrMsg2 ) + call setErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + + end subroutine SetParameters !---------------------------------------------------------------------------------------------------------------------------------- @@ -1107,7 +1050,7 @@ end subroutine AD_UpdateStates !! This subroutine is used to compute the output channels (motions and loads) and place them in the WriteOutput() array. !! The descriptions of the output channels are not given here. Please see the included OutListParameters.xlsx sheet for !! for a complete description of each output parameter. -subroutine AD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) +subroutine AD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, NeedWriteOutput ) ! NOTE: no matter how many channels are selected for output, all of the outputs are calculated ! All of the calculated output channels are placed into the m%AllOuts(:), while the channels selected for outputs are ! placed in the y%WriteOutput(:) array. @@ -1125,6 +1068,7 @@ subroutine AD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) type(AD_MiscVarType), intent(inout) :: m !< Misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + LOGICAL, OPTIONAL, INTENT(IN ) :: NeedWriteOutput !< Flag to determine if WriteOutput values need to be calculated in this call integer, parameter :: indx = 1 ! m%BEMT_u(1) is at t; m%BEMT_u(2) is t+dt @@ -1135,10 +1079,17 @@ subroutine AD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) character(ErrMsgLen) :: ErrMsg2 character(*), parameter :: RoutineName = 'AD_CalcOutput' real(ReKi) :: SigmaCavitCrit, SigmaCavit - + LOGICAL :: CalcWriteOutput + ErrStat = ErrID_None ErrMsg = "" + if (present(NeedWriteOutput)) then + CalcWriteOutput = NeedWriteOutput + else + CalcWriteOutput = .true. ! by default, calculate WriteOutput unless told that we do not need it + end if + call SetInputs(p, u, m, indx, errStat2, errMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1182,28 +1133,28 @@ subroutine AD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) !------------------------------------------------------- ! get values to output to file: !------------------------------------------------------- - if (p%NumOuts > 0) then -#ifdef DBG_OUTS - call Calc_WriteDbgOutput( p, u, m, y, ErrStat2, ErrMsg2 ) -#else - call Calc_WriteOutput( p, u, m, y, OtherState, indx, ErrStat2, ErrMsg2 ) -#endif - call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - - !............................................................................................................................... - ! Place the selected output channels into the WriteOutput(:) array with the proper sign: - !............................................................................................................................... - - do i = 1,p%NumOuts ! Loop through all selected output channels -#ifdef DBG_OUTS - y%WriteOutput(i) = m%AllOuts( i ) -#else - y%WriteOutput(i) = p%OutParam(i)%SignM * m%AllOuts( p%OutParam(i)%Indx ) -#endif - - end do ! i - All selected output channels - + if (CalcWriteOutput) then + if (p%NumOuts > 0) then + call Calc_WriteOutput( p, u, m, y, OtherState, indx, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + !............................................................................................................................... + ! Place the selected output channels into the WriteOutput(:) array with the proper sign: + !............................................................................................................................... + + do i = 1,p%NumOuts ! Loop through all selected output channels + y%WriteOutput(i) = p%OutParam(i)%SignM * m%AllOuts( p%OutParam(i)%Indx ) + end do ! i - All selected output channels + + end if + + y%WriteOutput(p%NumOuts+1:) = 0.0_ReKi + + ! Now we need to populate the blade node outputs here + call Calc_WriteAllBldNdOutput( p, u, m, y, OtherState, indx, ErrStat2, ErrMsg2 ) ! Call after normal writeoutput. Will just postpend data on here. + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end if + @@ -1245,7 +1196,7 @@ subroutine AD_CalcConstrStateResidual( Time, u, p, x, xd, z, OtherState, m, z_re end if - call SetInputs(p, u, m, indx, errStat2, errMsg2) + call SetInputs(p, u, m, indx, errStat2, errMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1350,7 +1301,7 @@ subroutine SetInputsForBEMT(p, u, m, indx, errStat, errMsg) end if ! "Angular velocity of rotor" rad/s - m%BEMT_u(indx)%omega = dot_product( u%HubMotion%RotationVel(:,1), x_hat_disk ) + m%BEMT_u(indx)%omega = dot_product( u%HubMotion%RotationVel(:,1), x_hat_disk ) ! "Angle between the vector normal to the rotor plane and the wind vector (e.g., the yaw angle in the case of no tilt)" rad tmp_sz = TwoNorm( m%V_diskAvg ) @@ -1388,9 +1339,7 @@ subroutine SetInputsForBEMT(p, u, m, indx, errStat, errMsg) call LAPACK_gemm( 'n', 't', 1.0_R8Ki, u%BladeRootMotion(k)%Orientation(:,:,1), u%HubMotion%Orientation(:,:,1), 0.0_R8Ki, orientation, errStat2, errMsg2) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) theta = EulerExtract( orientation ) !hub_theta_root(k) -#ifndef DBG_OUTS m%AllOuts( BPitch( k) ) = -theta(3)*R2D ! save this value of pitch for potential output -#endif theta(3) = 0.0_ReKi m%hub_theta_x_root(k) = theta(1) ! save this value for FAST.Farm @@ -2431,6 +2380,206 @@ END SUBROUTINE TwrInfl_NearestPoint !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the inputs (u). The partial derivatives dY/du, dX/du, dXd/du, and dZ/du are returned. SUBROUTINE AD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu) +!.................................................................................................................................. + + REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point + TYPE(AD_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) + TYPE(AD_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(AD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at operating point + TYPE(AD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at operating point + TYPE(AD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at operating point + TYPE(AD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at operating point + TYPE(AD_OutputType), INTENT(INOUT) :: y !< Output (change to inout if a mesh copy is required); + !! Output fields are not used by this routine, but type is + !! available here so that mesh parameter information (i.e., + !! connectivity) does not have to be recalculated for dYdu. + TYPE(AD_MiscVarType), INTENT(INOUT) :: m !< Misc/optimization variables + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dYdu(:,:) !< Partial derivatives of output functions (Y) with respect + !! to the inputs (u) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXdu(:,:) !< Partial derivatives of continuous state functions (X) with + !! respect to the inputs (u) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dXddu(:,:) !< Partial derivatives of discrete state functions (Xd) with + !! respect to the inputs (u) [intent in to avoid deallocation] + REAL(R8Ki), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dZdu(:,:) !< Partial derivatives of constraint state functions (Z) with + !! respect to the inputs (u) [intent in to avoid deallocation] + ! local variables + TYPE(AD_OutputType) :: y_p + TYPE(AD_OutputType) :: y_m + TYPE(AD_ContinuousStateType) :: x_copy + TYPE(AD_DiscreteStateType) :: xd_copy + TYPE(AD_ConstraintStateType) :: z_copy + TYPE(AD_OtherStateType) :: OtherState_copy + TYPE(AD_InputType) :: u_perturb(1) + REAL(R8Ki) :: delta_p, delta_m ! delta change in input + INTEGER(IntKi) :: i, j, k, n + + integer, parameter :: indx = 1 ! m%BEMT_u(1) is at t; m%BEMT_u(2) is t+dt + integer, parameter :: op_indx = 2 ! m%BEMT_u(1) is at t; m%BEMT_u(2) is t+dt or the input at OP + integer(intKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + character(*), parameter :: RoutineName = 'AD_JacobianPInput' + + + ! Initialize ErrStat + + ErrStat = ErrID_None + ErrMsg = '' + + + ! get OP values here: + !call AD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat2, ErrMsg2 ) + call SetInputsForBEMT(p, u, m, indx, errStat2, errMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later + call BEMT_CopyInput( m%BEMT_u(indx), m%BEMT_u(op_indx), MESH_UPDATECOPY, ErrStat2, ErrMsg2) ! copy the BEMT OP inputs to a temporary location that won't be overwritten + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later + + + if ( p%FrozenWake ) then + ! compare arguments with call to BEMT_CalcOutput + call computeFrozenWake(m%BEMT_u(op_indx), p%BEMT, m%BEMT_y, m%BEMT ) + m%BEMT%UseFrozenWake = .true. + end if + + + ! make a copy of the inputs to perturb + call AD_CopyInput( u, u_perturb(1), MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat>=AbortErrLev) then + call cleanup() + return + end if + + + IF ( PRESENT( dYdu ) ) THEN + ! Calculate the partial derivative of the output functions (Y) with respect to the inputs (u) here: + + ! allocate dYdu + if (.not. allocated(dYdu) ) then + call AllocAry(dYdu,p%Jac_ny, size(p%Jac_u_indx,1),'dYdu', ErrStat2, ErrMsg2) + call setErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat>=AbortErrLev) then + call cleanup() + return + end if + end if + + + ! make a copy of outputs because we will need two for the central difference computations (with orientations) + call AD_CopyOutput( y, y_p, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call AD_CopyOutput( y, y_m, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + ! make a copy of the states to perturb + call AD_CopyContState( x, x_copy, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call AD_CopyDiscState( xd, xd_copy, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call AD_CopyConstrState( z, z_copy, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call AD_CopyOtherState( OtherState, OtherState_copy, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + if (ErrStat>=AbortErrLev) then + call cleanup() + return + end if + + do i=1,size(p%Jac_u_indx,1) + + ! get u_op + delta_p u + call AD_CopyInput( u, u_perturb(1), MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later + call Perturb_u( p, i, 1, u_perturb(1), delta_p ) + + call AD_CopyContState( x, x_copy, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call AD_CopyDiscState( xd, xd_copy, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call AD_CopyConstrState( z, z_copy, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call AD_CopyOtherState( OtherState, OtherState_copy, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + + call AD_UpdateStates( t, 1, u_perturb, (/t/), p, x_copy, xd_copy, z_copy, OtherState_copy, m, errStat2, errMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + ! compute y at u_op + delta_p u + call AD_CalcOutput( t, u_perturb(1), p, x_copy, xd_copy, z_copy, OtherState_copy, y_p, m, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later + + + ! get u_op - delta_m u + call AD_CopyInput( u, u_perturb(1), MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later + call Perturb_u( p, i, -1, u_perturb(1), delta_m ) + + call AD_CopyContState( x, x_copy, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call AD_CopyDiscState( xd, xd_copy, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call AD_CopyConstrState( z, z_copy, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call AD_CopyOtherState( OtherState, OtherState_copy, MESH_UPDATECOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + call AD_UpdateStates( t, 1, u_perturb, (/t/), p, x_copy, xd_copy, z_copy, OtherState_copy, m, errStat2, errMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + + ! compute y at u_op - delta_m u + call AD_CalcOutput( t, u_perturb(1), p, x_copy, xd_copy, z_copy, OtherState_copy, y_m, m, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later + + + ! get central difference: + call Compute_dY( p, y_p, y_m, delta_p, delta_m, dYdu(:,i) ) + + end do + + + if (ErrStat>=AbortErrLev) then + call cleanup() + return + end if + + END IF + + IF ( PRESENT( dXdu ) ) THEN + if (allocated(dXdu)) deallocate(dXdu) + END IF + + IF ( PRESENT( dXddu ) ) THEN + if (allocated(dXddu)) deallocate(dXddu) + END IF + + IF ( PRESENT( dZdu ) ) THEN + if (allocated(dZdu)) deallocate(dZdu) + END IF + + call cleanup() +contains + subroutine cleanup() + m%BEMT%UseFrozenWake = .false. + + call AD_DestroyOutput( y_p, ErrStat2, ErrMsg2 ) + call AD_DestroyOutput( y_m, ErrStat2, ErrMsg2 ) + call AD_DestroyContState( x_copy, ErrStat2, ErrMsg2) + call AD_DestroyDiscState( xd_copy, ErrStat2, ErrMsg2) + call AD_DestroyConstrState( z_copy, ErrStat2, ErrMsg2) + call AD_DestroyOtherState( OtherState_copy, ErrStat2, ErrMsg2) + + call AD_DestroyInput( u_perturb(1), ErrStat2, ErrMsg2 ) + end subroutine cleanup + +END SUBROUTINE AD_JacobianPInput +!---------------------------------------------------------------------------------------------------------------------------------- +!> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions +!! with respect to the inputs (u). The partial derivatives dY/du, dX/du, dXd/du, and dZ/du are returned. +SUBROUTINE AD_JacobianPInput_orig( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, dYdu, dXdu, dXddu, dZdu) +! This routine should be used instead of AD_JacobianPInput iff `OLD_AD_LINEAR` is defined in the FAST glue code. !.................................................................................................................................. REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point @@ -2463,7 +2612,8 @@ SUBROUTINE AD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM TYPE(AD_InputType) :: u_perturb REAL(R8Ki) :: delta_p, delta_m ! delta change in input INTEGER(IntKi) :: i, j, k, n - logical :: ValidInput + logical :: ValidInput_p + logical :: ValidInput_m integer, parameter :: indx = 1 ! m%BEMT_u(1) is at t; m%BEMT_u(2) is t+dt integer, parameter :: op_indx = 2 ! m%BEMT_u(1) is at t; m%BEMT_u(2) is t+dt or the input at OP @@ -2536,13 +2686,13 @@ SUBROUTINE AD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ! we need to see if these perturbed inputs put us in different solution regions: call SetInputsForBEMT(p, u_perturb, m, indx, errStat2, errMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - ValidInput = CheckBEMTInputPerturbations( p, m ) + ValidInput_p = CheckBEMTInputPerturbations( p, m ) ! if so, we do a 1-sided difference: - if (.not. ValidInput) then + if (.not. ValidInput_p) then call AD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - delta_p = 0 + delta_p = 0.0_R8Ki end if @@ -2559,14 +2709,14 @@ SUBROUTINE AD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ! we need to see if these perturbed inputs put us in different solution regions: call SetInputsForBEMT(p, u_perturb, m, indx, errStat2, errMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - ValidInput = CheckBEMTInputPerturbations( p, m ) + ValidInput_m = CheckBEMTInputPerturbations( p, m ) ! if so, we do a 1-sided difference: - if (.not. ValidInput) then + if (.not. ValidInput_m) then call AD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - delta_m = 0 - if (EqualRealNos(delta_p, 0.0_R8Ki)) then + delta_m = 0.0_R8Ki + if (.not. ValidInput_p) then call SetErrStat(ErrID_Fatal,'Both sides of central difference equation change solution region. '// & 'dYdu cannot be calculated for column '//trim(num2lstr(i))//'.',ErrStat,ErrMsg,RoutineName) return @@ -2636,13 +2786,13 @@ SUBROUTINE AD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ! we need to see if these perturbed inputs put us in different solution regions: call SetInputsForBEMT(p, u_perturb, m, indx, errStat2, errMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - ValidInput = CheckBEMTInputPerturbations( p, m ) + ValidInput_p = CheckBEMTInputPerturbations( p, m ) ! if so, we do a 1-sided difference: - if (.not. ValidInput) then + if (.not. ValidInput_p) then call AD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - delta_p = 0 + delta_p = 0.0_R8Ki end if @@ -2659,14 +2809,14 @@ SUBROUTINE AD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ! we need to see if these perturbed inputs put us in different solution regions: call SetInputsForBEMT(p, u_perturb, m, indx, errStat2, errMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - ValidInput = CheckBEMTInputPerturbations( p, m ) + ValidInput_m = CheckBEMTInputPerturbations( p, m ) ! if so, we do a 1-sided difference: - if (.not. ValidInput) then + if (.not. ValidInput_m) then call AD_CopyInput( u, u_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! we shouldn't have any errors about allocating memory here so I'm not going to return-on-error until later - delta_m = 0 - if (EqualRealNos(delta_p, 0.0_R8Ki)) then + delta_m = 0.0_R8Ki + if (.not. ValidInput_p) then call SetErrStat(ErrID_Fatal,'Both sides of central difference equation change solution region. '// & 'dYdu cannot be calculated for column '//trim(num2lstr(i))//'.',ErrStat,ErrMsg,RoutineName) return @@ -2716,7 +2866,7 @@ subroutine cleanup() call AD_DestroyInput( u_perturb, ErrStat2, ErrMsg2 ) end subroutine cleanup -END SUBROUTINE AD_JacobianPInput +END SUBROUTINE AD_JacobianPInput_orig !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to compute the Jacobians of the output (Y), continuous- (X), discrete- (Xd), and constraint-state (Z) functions !! with respect to the continuous states (x). The partial derivatives dY/dx, dX/dx, dXd/dx, and dZ/dx are returned. @@ -2923,8 +3073,6 @@ SUBROUTINE AD_JacobianPConstrState( t, u, p, x, xd, z, OtherState, y, m, ErrStat ErrStat = ErrID_None ErrMsg = '' - -!bjj: how do I figure out if F is 0??? In that case, need to se dY/dz = 0 and dZ/dz = 1 {and need to ask jmj if this is the whole matrix or just a row/column where it applies} ! get OP values here: !call AD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat2, ErrMsg2 ) ! (bjj: is this necessary? if not, still need to get BEMT inputs) @@ -3238,7 +3386,7 @@ SUBROUTINE AD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, end do index = index - 1 - do i=1,p%NumOuts + do i=1,p%NumOuts + p%BldNd_TotNumOuts y_op(i+index) = y%WriteOutput(i) end do @@ -3300,8 +3448,8 @@ SUBROUTINE Init_Jacobian_y( p, y, InitOut, ErrStat, ErrMsg) ! determine how many outputs there are in the Jacobians - p%Jac_ny = y%TowerLoad%NNodes * 6 & ! 3 forces + 3 moments at each node - + p%NumOuts ! WriteOutput values + p%Jac_ny = y%TowerLoad%NNodes * 6 & ! 3 forces + 3 moments at each node + + p%NumOuts + p%BldNd_TotNumOuts ! WriteOutput values do k=1,p%NumBlades p%Jac_ny = p%Jac_ny + y%BladeLoad(k)%NNodes * 6 ! 3 forces + 3 moments at each node @@ -3324,7 +3472,7 @@ SUBROUTINE Init_Jacobian_y( p, y, InitOut, ErrStat, ErrMsg) end do ! InitOut%RotFrame_y(indx_last:indx_next-1) = .true. ! The mesh fields are in the global frame, so are not in the rotating frame - do i=1,p%NumOuts + do i=1,p%NumOuts + p%BldNd_TotNumOuts InitOut%LinNames_y(i+indx_next-1) = trim(InitOut%WriteOutputHdr(i))//', '//trim(InitOut%WriteOutputUnt(i)) !trim(p%OutParam(i)%Name)//', '//p%OutParam(i)%Units end do @@ -3384,6 +3532,12 @@ SUBROUTINE Init_Jacobian_y( p, y, InitOut, ErrStat, ErrMsg) InitOut%RotFrame_y(i+indx_next-1) = AllOut( p%OutParam(i)%Indx ) end do + do i=1,p%BldNd_TotNumOuts + InitOut%RotFrame_y(i+p%NumOuts+indx_next-1) = .true. + !AbsCant, AbsToe, AbsTwist should probably be set to .false. + end do + + deallocate(AllOut) END SUBROUTINE Init_Jacobian_y @@ -3770,7 +3924,7 @@ SUBROUTINE Compute_dY(p, y_p, y_m, delta_p, delta_m, dY) end do - do k=1,p%NumOuts + do k=1,p%NumOuts + p%BldNd_TotNumOuts dY(k+indx_first-1) = y_p%WriteOutput(k) - y_m%WriteOutput(k) end do @@ -3852,7 +4006,7 @@ FUNCTION CheckBEMTInputPerturbations( p, m ) RESULT(ValidPerturb) do k=1,p%NumBlades do j=1,p%NumBlNds - ! don't allow the input perturbations to change Vx or Vy so that Vx=0 or Vy=0: + ! don't allow the input perturbations to change Vx or Vy so that Vx=0 and Vy=0: if ( EqualRealNos( m%BEMT_u(indx)%Vx(j,k), 0.0_ReKi ) .and. EqualRealNos( m%BEMT_u(indx)%Vy(j,k), 0.0_ReKi ) ) then ValidPerturb = .false. return diff --git a/modules/aerodyn/src/AeroDyn_AllBldNdOuts_IO.f90 b/modules/aerodyn/src/AeroDyn_AllBldNdOuts_IO.f90 new file mode 100644 index 0000000000..78571099d2 --- /dev/null +++ b/modules/aerodyn/src/AeroDyn_AllBldNdOuts_IO.f90 @@ -0,0 +1,833 @@ +! This module is an add on to AeroDyn 15 to allow output of Aerodynamic data at each blade node. +! +! Copyright 2016 Envision Energy +! +MODULE AeroDyn_AllBldNdOuts_IO + + USE NWTC_Library + USE NWTC_LAPACK + USE AeroDyn_Types + + IMPLICIT NONE + + PRIVATE + + PUBLIC :: AllBldNdOuts_InitOut + PUBLIC :: Calc_WriteAllBldNdOutput + PUBLIC :: AllBldNdOuts_SetParameters + + + ! Parameters related to output length (number of characters allowed in the output data headers): + + INTEGER(IntKi), PARAMETER :: OutStrLenM1 = ChanLen - 6 ! The NREL allowed channel name length is usually 20. We are making these of the form B#N##namesuffix + + +! =================================================================================================== +! NOTE: The following lines of code were generated by a Matlab script called "Write_ChckOutLst.m" +! using the parameters listed in the "OutListParameters.xlsx" Excel file. Any changes to these +! lines should be modified in the Matlab script and/or Excel worksheet as necessary. +! =================================================================================================== +! This code was generated by Write_ChckOutLst.m at 12-Dec-2017 22:02:25. + + + ! NOTES: + ! (1) These parameters are in the order stored in "OutListParameters.xlsx" + + + ! Blade: + + INTEGER(IntKi), PARAMETER :: BldNd_VUndx = 1 + INTEGER(IntKi), PARAMETER :: BldNd_VUndy = 2 + INTEGER(IntKi), PARAMETER :: BldNd_VUndz = 3 + INTEGER(IntKi), PARAMETER :: BldNd_VDisx = 4 + INTEGER(IntKi), PARAMETER :: BldNd_VDisy = 5 + INTEGER(IntKi), PARAMETER :: BldNd_VDisz = 6 + INTEGER(IntKi), PARAMETER :: BldNd_STVx = 7 + INTEGER(IntKi), PARAMETER :: BldNd_STVy = 8 + INTEGER(IntKi), PARAMETER :: BldNd_STVz = 9 + INTEGER(IntKi), PARAMETER :: BldNd_VRel = 10 + INTEGER(IntKi), PARAMETER :: BldNd_DynP = 11 + INTEGER(IntKi), PARAMETER :: BldNd_Re = 12 + INTEGER(IntKi), PARAMETER :: BldNd_M = 13 + INTEGER(IntKi), PARAMETER :: BldNd_Vindx = 14 + INTEGER(IntKi), PARAMETER :: BldNd_Vindy = 15 + INTEGER(IntKi), PARAMETER :: BldNd_AxInd = 16 + INTEGER(IntKi), PARAMETER :: BldNd_TnInd = 17 + INTEGER(IntKi), PARAMETER :: BldNd_Alpha = 18 + INTEGER(IntKi), PARAMETER :: BldNd_Theta = 19 + INTEGER(IntKi), PARAMETER :: BldNd_Phi = 20 + INTEGER(IntKi), PARAMETER :: BldNd_Curve = 21 + INTEGER(IntKi), PARAMETER :: BldNd_Cl = 22 + INTEGER(IntKi), PARAMETER :: BldNd_Cd = 23 + INTEGER(IntKi), PARAMETER :: BldNd_Cm = 24 + INTEGER(IntKi), PARAMETER :: BldNd_Cx = 25 + INTEGER(IntKi), PARAMETER :: BldNd_Cy = 26 + INTEGER(IntKi), PARAMETER :: BldNd_Cn = 27 + INTEGER(IntKi), PARAMETER :: BldNd_Ct = 28 + INTEGER(IntKi), PARAMETER :: BldNd_Fl = 29 + INTEGER(IntKi), PARAMETER :: BldNd_Fd = 30 + INTEGER(IntKi), PARAMETER :: BldNd_Mm = 31 + INTEGER(IntKi), PARAMETER :: BldNd_Fx = 32 + INTEGER(IntKi), PARAMETER :: BldNd_Fy = 33 + INTEGER(IntKi), PARAMETER :: BldNd_Fn = 34 + INTEGER(IntKi), PARAMETER :: BldNd_Ft = 35 + INTEGER(IntKi), PARAMETER :: BldNd_Clrnc = 36 + INTEGER(IntKi), PARAMETER :: BldNd_Vx = 37 + INTEGER(IntKi), PARAMETER :: BldNd_Vy = 38 + INTEGER(IntKi), PARAMETER :: BldNd_GeomPhi = 39 + INTEGER(IntKi), PARAMETER :: BldNd_Chi = 40 + INTEGER(IntKi), PARAMETER :: BldNd_UA_Flag = 41 + + ! The maximum number of output channels which can be output by the code. + INTEGER(IntKi), PARAMETER, PUBLIC :: BldNd_MaxOutPts = 41 + +!End of code generated by Matlab script +! =================================================================================================== + +CONTAINS +!---------------------------------------------------------------------------------------------------------------------------------- + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This subroutine populates the headers with the blade node outputs. The iteration cycle is blade:node:channel (channel iterated +!! fastest). If this iteration order is changed, it should be changed in the Calc_WriteAllBldNdOutput routine as well. +SUBROUTINE AllBldNdOuts_InitOut( InitOut, p, InputFileData, ErrStat, ErrMsg ) + + TYPE(AD_InitOutputType), INTENT(INOUT) :: InitOut ! output data + TYPE(AD_ParameterType), INTENT(IN ) :: p ! The module parameters + TYPE(AD_InputFile), INTENT(IN ) :: InputFileData ! All the data in the AeroDyn input file (want Blade Span for channel name) + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! The error status code + CHARACTER(*), INTENT( OUT) :: ErrMsg ! The error message, if an error occurred + + INTEGER(IntKi) :: INDX ! Index count within WriteOutput + INTEGER(IntKi) :: IdxBlade ! Counter to which blade we are on + INTEGER(IntKi) :: IdxNode ! Counter to the blade node we ae on + INTEGER(IntKi) :: IdxChan ! Counter to the channel we are outputting. + CHARACTER(16) :: ChanPrefix ! Name prefix (AB#N###) + CHARACTER(6) :: TmpChar ! Temporary char array to hold the node digits (3 places only!!!!) + CHARACTER(*), PARAMETER :: RoutineName = ('AllBldNdOuts_InitOut') + + + ! Initialize some things + ErrMsg = '' + ErrStat = ErrID_None + + + ! Warn if we will run into issues with more than 99 nodes. + IF (p%NumBlNds > 999 ) CALL SetErrStat(ErrID_Severe,'More than 999 blade nodes in use. Output channel headers will not '// & + 'correctly reflect blade stations beyond 999. Modifications to the variable ChanLen in FAST are required.',ErrStat,ErrMsg,RoutineName) + + + ! Populate the header an unit lines for all blades and nodes + ! First set a counter so we know where in the output array we are in + INDX = p%NumOuts + 1 ! p%NumOuts is the number of outputs from the normal AeroDyn output. The WriteOutput array is sized to p%NumOuts + num(AllBldNdOuts) + + DO IdxChan=1,p%BldNd_NumOuts + + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + + ! Create the name prefix: + WRITE (TmpChar,'(I3.3)') IdxNode ! 3 digit number + ChanPrefix = 'AB' // TRIM(Num2LStr(IdxBlade)) // 'N' // TRIM(TmpChar) ! // '_' ! note that I added an "AB" to indicate "Aero B1" in case of confusion with structural nodal outputs with the same name + ! Now write to the header + InitOut%WriteOutputHdr(INDX) = trim(ChanPrefix) // p%BldNd_OutParam(IdxChan)%Name + InitOut%WriteOutputUnt(INDX) = p%BldNd_OutParam(IdxChan)%Units + + ! Increment the index to the Header arrays + INDX = INDX + 1 + + ENDDO + ENDDO + + ENDDO + +END SUBROUTINE AllBldNdOuts_InitOut + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This subroutine populates the headers with the blade node outputs. The iteration cycle is channel:blade:node (node iterated +!! fastest). If this iteration order is changed, it should be changed in the Calc_WriteAllBldNdOutput routine as well. +!! +!! NOTE: the equations here came from the output section of AeroDyn_IO.f90. If anything changes in there, it needs to be reflected +!! here. + +SUBROUTINE Calc_WriteAllBldNdOutput( p, u, m, y, OtherState, Indx, ErrStat, ErrMsg ) + TYPE(AD_ParameterType), INTENT(IN ) :: p ! The module parameters + TYPE(AD_InputType), INTENT(IN ) :: u ! inputs + TYPE(AD_MiscVarType), INTENT(IN ) :: m ! misc variables + TYPE(AD_OutputType), INTENT(INOUT) :: y ! outputs (updates y%WriteOutput) + TYPE(AD_OtherStateType), INTENT(IN ) :: OtherState ! other states + INTEGER, INTENT(IN ) :: Indx ! index into m%BEMT_u(Indx) array; 1=t and 2=t+dt (but not checked here) + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! The error status code + CHARACTER(*), INTENT( OUT) :: ErrMsg ! The error message, if an error occurred + + ! local variables + + INTEGER(IntKi) :: OutIdx ! Index count within WriteOutput + INTEGER(IntKi) :: IdxBlade ! Counter to which blade we are on + INTEGER(IntKi) :: IdxNode ! Counter to the blade node we ae on + INTEGER(IntKi) :: IdxChan ! Counter to the channel we are outputting. + CHARACTER(*), PARAMETER :: RoutineName = 'Calc_WriteAllBldNdOutput' + REAL(ReKi) :: ct, st ! cosine, sine of theta + REAL(ReKi) :: cp, sp ! cosine, sine of phi + + ! Initialize some things + ErrMsg = '' + ErrStat = ErrID_None + + + ! Populate the header an unit lines for all blades and nodes + ! First set a counter so we know where in the output array we are in + OutIdx = p%NumOuts + 1 ! p%NumOuts is the number of outputs from the normal AeroDyn output. The WriteOutput array is sized to p%NumOuts + num(AllBldNdOuts) + + + ! Case to assign output to this channel and populate based on Indx value (this indicates what the channel is) + ! Logic and mathematics used here come from Calc_WriteOutput + DO IdxChan=1,p%BldNd_NumOuts + + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + CASE (0) ! Invalid channel + CYCLE + ! ***** Undisturbed wind velocity in local blade coord system ***** + CASE ( BldNd_VUndx ) + + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + + !Tmp3 = matmul( m%WithoutSweepPitchTwist(:,:,IdxNode,IdxBlade), u%InflowOnBlade(:,IdxNode,IdxBlade) ) + !y%WriteOutput( OutIdx ) = Tmp3(1) + y%WriteOutput( OutIdx ) = dot_product( m%WithoutSweepPitchTwist(1,:,IdxNode,IdxBlade), u%InflowOnBlade(:,IdxNode,IdxBlade) ) + + OutIdx = OutIdx + 1 + END DO + END DO + + + CASE ( BldNd_VUndy ) + + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + + !Tmp3 = matmul( m%WithoutSweepPitchTwist(:,:,IdxNode,IdxBlade), u%InflowOnBlade(:,IdxNode,IdxBlade) ) + !y%WriteOutput( OutIdx ) = Tmp3(2) + y%WriteOutput( OutIdx ) = dot_product( m%WithoutSweepPitchTwist(2,:,IdxNode,IdxBlade), u%InflowOnBlade(:,IdxNode,IdxBlade) ) + + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_VUndz ) + + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + + !Tmp3 = matmul( m%WithoutSweepPitchTwist(:,:,IdxNode,IdxBlade), u%InflowOnBlade(:,IdxNode,IdxBlade) ) + !y%WriteOutput( OutIdx ) = Tmp3(3) + y%WriteOutput( OutIdx ) = dot_product( m%WithoutSweepPitchTwist(3,:,IdxNode,IdxBlade), u%InflowOnBlade(:,IdxNode,IdxBlade) ) + + OutIdx = OutIdx + 1 + END DO + END DO + + + + ! ***** Disturbed wind velocity in the local blade coordinate system ***** + CASE ( BldNd_VDisx ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + + !Tmp3 = matmul( m%WithoutSweepPitchTwist(:,:,IdxNode,IdxBlade), m%DisturbedInflow(:,IdxNode,IdxBlade) ) + !y%WriteOutput( OutIdx ) = Tmp3(1) + y%WriteOutput( OutIdx ) = dot_product( m%WithoutSweepPitchTwist(1,:,IdxNode,IdxBlade), m%DisturbedInflow(:,IdxNode,IdxBlade) ) + + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_VDisy ) + + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + + !Tmp3 = matmul( m%WithoutSweepPitchTwist(:,:,IdxNode,IdxBlade), m%DisturbedInflow(:,IdxNode,IdxBlade) ) + !y%WriteOutput( OutIdx ) = Tmp3(2) + y%WriteOutput( OutIdx ) = dot_product( m%WithoutSweepPitchTwist(2,:,IdxNode,IdxBlade), m%DisturbedInflow(:,IdxNode,IdxBlade) ) + + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_VDisz ) + + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + + !Tmp3 = matmul( m%WithoutSweepPitchTwist(:,:,IdxNode,IdxBlade), m%DisturbedInflow(:,IdxNode,IdxBlade) ) + !y%WriteOutput( OutIdx ) = Tmp3(3) + y%WriteOutput( OutIdx ) = dot_product( m%WithoutSweepPitchTwist(3,:,IdxNode,IdxBlade), m%DisturbedInflow(:,IdxNode,IdxBlade) ) + + OutIdx = OutIdx + 1 + END DO + END DO + + + ! ***** Structural translational velocity in the local blade coordinate system ***** + CASE ( BldNd_STVx ) + + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + !Tmp3 = matmul( m%WithoutSweepPitchTwist(:,:,IdxNode,IdxBlade), u%BladeMotion(IdxBlade)%TranslationVel(:,IdxNode) ) + !y%WriteOutput( OutIdx ) = Tmp3(1) + y%WriteOutput( OutIdx ) = dot_product( m%WithoutSweepPitchTwist(1,:,IdxNode,IdxBlade), u%BladeMotion(IdxBlade)%TranslationVel(:,IdxNode) ) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_STVy ) + + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + !Tmp3 = matmul( m%WithoutSweepPitchTwist(:,:,IdxNode,IdxBlade), u%BladeMotion(IdxBlade)%TranslationVel(:,IdxNode) ) + !y%WriteOutput( OutIdx ) = Tmp3(2) + y%WriteOutput( OutIdx ) = dot_product( m%WithoutSweepPitchTwist(2,:,IdxNode,IdxBlade), u%BladeMotion(IdxBlade)%TranslationVel(:,IdxNode) ) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_STVz ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + !Tmp3 = matmul( m%WithoutSweepPitchTwist(:,:,IdxNode,IdxBlade), u%BladeMotion(IdxBlade)%TranslationVel(:,IdxNode) ) + !y%WriteOutput( OutIdx ) = Tmp3(3) + y%WriteOutput( OutIdx ) = dot_product( m%WithoutSweepPitchTwist(3,:,IdxNode,IdxBlade), u%BladeMotion(IdxBlade)%TranslationVel(:,IdxNode) ) + OutIdx = OutIdx + 1 + END DO + END DO + + + ! Relative wind speed + CASE ( BldNd_VRel ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%BEMT_y%Vrel(IdxNode,IdxBlade) + OutIdx = OutIdx + 1 + END DO + END DO + + ! Dynamic pressure + CASE ( BldNd_DynP ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = 0.5 * p%airDens * m%BEMT_y%Vrel(IdxNode,IdxBlade)**2 + OutIdx = OutIdx + 1 + END DO + END DO + + ! Reynolds number (in millions) + CASE ( BldNd_Re ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = p%BEMT%chord(IdxNode,IdxBlade) * m%BEMT_y%Vrel(IdxNode,IdxBlade) / p%KinVisc / 1.0E6 + OutIdx = OutIdx + 1 + END DO + END DO + + ! Mach number + CASE ( BldNd_M ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%BEMT_y%Vrel(IdxNode,IdxBlade) / p%SpdSound + OutIdx = OutIdx + 1 + END DO + END DO + + + ! Axial and tangential induced wind velocity + CASE ( BldNd_Vindx ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = - m%BEMT_u(Indx)%Vx(IdxNode,IdxBlade) * m%BEMT_y%axInduction( IdxNode,IdxBlade) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_Vindy ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%BEMT_u(Indx)%Vy(IdxNode,IdxBlade) * m%BEMT_y%tanInduction(IdxNode,IdxBlade) + OutIdx = OutIdx + 1 + END DO + END DO + + + ! Axial and tangential induction factors + CASE ( BldNd_AxInd ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%BEMT_y%axInduction(IdxNode,IdxBlade) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_TnInd ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%BEMT_y%tanInduction(IdxNode,IdxBlade) + OutIdx = OutIdx + 1 + END DO + END DO + + + ! AoA, pitch+twist angle, inflow angle, and curvature angle + CASE ( BldNd_Alpha ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = Rad2M180to180Deg( m%BEMT_y%phi(IdxNode,IdxBlade) - m%BEMT_u(Indx)%theta(IdxNode,IdxBlade) ) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_Theta ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%BEMT_u(Indx)%theta(IdxNode,IdxBlade)*R2D + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_Phi ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%BEMT_y%phi(IdxNode,IdxBlade)*R2D + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_Curve ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%Curve(IdxNode,IdxBlade)*R2D + OutIdx = OutIdx + 1 + END DO + END DO + + + ! Lift force, drag force, pitching moment coefficients + CASE ( BldNd_Cl ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%BEMT_y%Cl(IdxNode,IdxBlade) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_Cd ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%BEMT_y%Cd(IdxNode,IdxBlade) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_Cm ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%BEMT_y%Cm(IdxNode,IdxBlade) + OutIdx = OutIdx + 1 + END DO + END DO + + ! Normal force (to plane), tangential force (to plane) coefficients + CASE ( BldNd_Cx ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%BEMT_y%Cx(IdxNode,IdxBlade) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_Cy ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%BEMT_y%Cy(IdxNode,IdxBlade) + OutIdx = OutIdx + 1 + END DO + END DO + + ! Normal force (to chord), and tangential force (to chord) coefficients + CASE ( BldNd_Cn ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + ct=cos(m%BEMT_u(Indx)%theta(IdxNode,IdxBlade)) + st=sin(m%BEMT_u(Indx)%theta(IdxNode,IdxBlade)) + y%WriteOutput( OutIdx ) = m%BEMT_y%Cx(IdxNode,IdxBlade)*ct + m%BEMT_y%Cy(IdxNode,IdxBlade)*st + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_Ct ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + ct=cos(m%BEMT_u(Indx)%theta(IdxNode,IdxBlade)) + st=sin(m%BEMT_u(Indx)%theta(IdxNode,IdxBlade)) + y%WriteOutput( OutIdx ) = -m%BEMT_y%Cx(IdxNode,IdxBlade)*st + m%BEMT_y%Cy(IdxNode,IdxBlade)*ct + OutIdx = OutIdx + 1 + END DO + END DO + + + ! Lift force, drag force, pitching moment + CASE ( BldNd_Fl ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + cp=cos(m%BEMT_y%phi(IdxNode,IdxBlade)) + sp=sin(m%BEMT_y%phi(IdxNode,IdxBlade)) + y%WriteOutput( OutIdx ) = m%X(IdxNode,IdxBlade)*cp - m%Y(IdxNode,IdxBlade)*sp + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_Fd ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + cp=cos(m%BEMT_y%phi(IdxNode,IdxBlade)) + sp=sin(m%BEMT_y%phi(IdxNode,IdxBlade)) + y%WriteOutput( OutIdx ) = m%X(IdxNode,IdxBlade)*sp + m%Y(IdxNode,IdxBlade)*cp + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_Mm ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%M(IdxNode,IdxBlade) + OutIdx = OutIdx + 1 + END DO + END DO + + ! Normal force (to plane), tangential force (to plane) + CASE ( BldNd_Fx ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%X(IdxNode,IdxBlade) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_Fy ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = -m%Y(IdxNode,IdxBlade) + OutIdx = OutIdx + 1 + END DO + END DO + + ! Normal force (to chord), and tangential force (to chord) per unit length + CASE ( BldNd_Fn ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + ct=cos(m%BEMT_u(Indx)%theta(IdxNode,IdxBlade)) + st=sin(m%BEMT_u(Indx)%theta(IdxNode,IdxBlade)) + y%WriteOutput( OutIdx ) = m%X(IdxNode,IdxBlade)*ct - m%Y(IdxNode,IdxBlade)*st + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_Ft ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + ct=cos(m%BEMT_u(Indx)%theta(IdxNode,IdxBlade)) + st=sin(m%BEMT_u(Indx)%theta(IdxNode,IdxBlade)) + y%WriteOutput( OutIdx ) = -m%X(IdxNode,IdxBlade)*st - m%Y(IdxNode,IdxBlade)*ct + OutIdx = OutIdx + 1 + END DO + END DO + + ! Tower clearance (requires tower influence calculation): + CASE ( BldNd_Clrnc ) + if (.not. allocated(m%TwrClrnc)) then + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = 0.0_ReKi + OutIdx = OutIdx + 1 + END DO + END DO + else + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%TwrClrnc(IdxNode,IdxBlade) + OutIdx = OutIdx + 1 + END DO + END DO + end if + + + CASE ( BldNd_Vx ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%BEMT_u(Indx)%Vx(IdxNode,IdxBlade) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_Vy ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%BEMT_u(Indx)%Vy(IdxNode,IdxBlade) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_GeomPhi ) + if (allocated(OtherState%BEMT%ValidPhi)) then + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + if (OtherState%BEMT%ValidPhi(IdxNode,IdxBlade)) then + y%WriteOutput( OutIdx ) = 0.0_ReKi + else + y%WriteOutput( OutIdx ) = 1.0_ReKi + end if + OutIdx = OutIdx + 1 + END DO + END DO + else + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = 1.0_ReKi + OutIdx = OutIdx + 1 + END DO + END DO + end if + + CASE ( BldNd_chi ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%NumBlNds + y%WriteOutput( OutIdx ) = m%BEMT_y%chi(IdxNode,IdxBlade)*R2D + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_UA_Flag ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,u%BladeMotion(IdxBlade)%NNodes ! Note p%node_total is total number of nodes including all elements + IF ( OtherState%BEMT%UA_Flag(IdxNode, IdxBlade) ) THEN + y%WriteOutput( OutIdx ) = 1.0_ReKi + ELSE + y%WriteOutput( OutIdx ) = 0.0_ReKi + ENDIF + OutIdx = OutIdx + 1 + ENDDO + ENDDO + + + END SELECT + + END DO ! each channel + + +END SUBROUTINE Calc_WriteAllBldNdOutput + + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine validates and sets the parameters for the nodal outputs. +SUBROUTINE AllBldNdOuts_SetParameters( InitInp, InputFileData, p, ErrStat, ErrMsg ) +!.................................................................................................................................. + + + ! Passed variables: + + TYPE(AD_InitInputType), intent(IN ) :: InitInp !< Input data for initialization routine, out is needed because of copy below + TYPE(AD_InputFile), INTENT(IN ) :: InputFileData !< Data stored in the module's input file + TYPE(AD_ParameterType), INTENT(INOUT) :: p !< Parameters + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + + ! local variables + character(*), parameter :: RoutineName = 'AllBldNdOuts_SetParameters' + + ErrStat = ErrID_None + ErrMsg = "" + + + ! Check if the requested blades exist + IF ( (InputFileData%BldNd_BladesOut < 0_IntKi) .OR. (InputFileData%BldNd_BladesOut > p%NumBlades) ) THEN + CALL SetErrStat( ErrID_Warn, " Number of blades to output data at all blade nodes (BldNd_BladesOut) must be between 0 and "//TRIM(Num2LStr(p%NumBlades))//".", ErrStat, ErrMsg, RoutineName) + p%BldNd_BladesOut = 0_IntKi + ELSE + p%BldNd_BladesOut = InputFileData%BldNd_BladesOut + ENDIF + + + ! Check if the requested blade nodes are valid + ! InputFileData%BldNd_BlOutNd + + + ! Set the parameter to store number of requested Blade Node output sets + p%BldNd_NumOuts = InputFileData%BldNd_NumOuts + + ! Set the total number of outputs ( requested channel groups * number requested nodes * number requested blades ) + p%BldNd_TotNumOuts = p%BldNd_NumOuts*p%NumBlNds*p%BldNd_BladesOut ! p%BldNd_NumOuts * size(p%BldNd_BlOutNd) * size(p%BldNd_BladesOut) + +! ! Check if the blade node array to output is valid: p%BldNd_BlOutNd +! ! TODO: this value is not read in by the input file reading yet, so setting to all blade nodes +! ! -- check if list handed in is of nodes that exist (not sure this is ever checked) +! ! -- copy values over +! +! ! Temporary workaround here: +! ALLOCATE ( p%BldNd_BlOutNd(1:p%NumBlNds) , STAT=ErrStat2 ) +! IF ( ErrStat2 /= 0_IntKi ) THEN +! CALL SetErrStat( ErrID_Fatal,"Error allocating memory for the AeroDyn OutParam array.", ErrStat, ErrMsg, RoutineName ) +! RETURN +! ENDIF +! DO I=1,p%NumBlNds ! put all nodes in the list +! p%BldNd_BlOutNd(i) = i +! ENDDO + + +! ! Check if the requested blades are actually in use: +! ! TODO: this value is not read in by the input file reading yet, so setting to all blades +! ! -- check if list handed in is of blades that exist (not sure this is ever checked) +! ! -- copy values over +! ALLOCATE ( p%BldNd_BladesOut(1:p%NumBlades), STAT=ErrStat2 ) +! IF ( ErrStat2 /= 0_IntKi ) THEN +! CALL SetErrStat( ErrID_Fatal,"Error allocating memory for the AeroDyn OutParam array.", ErrStat, ErrMsg, RoutineName ) +! RETURN +! ENDIF +! DO I=1,p%NumBlades ! put all blades in the list +! p%BldNd_BladesOut(i) = i +! ENDDO + + if (p%BldNd_TotNumOuts > 0) then + call BldNdOuts_SetOutParam(InputFileData%BldNd_OutList, p, ErrStat, ErrMsg ) ! requires: p%NumOuts, p%numBlades, p%NumBlNds, p%NumTwrNds; sets: p%BldNdOutParam. + if (ErrStat >= AbortErrLev) return + end if + + + +END SUBROUTINE AllBldNdOuts_SetParameters + + +!********************************************************************************************************************************** +! NOTE: The following lines of code were generated by a Matlab script called "Write_ChckOutLst.m" +! using the parameters listed in the "OutListParameters.xlsx" Excel file. Any changes to these +! lines should be modified in the Matlab script and/or Excel worksheet as necessary. +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine checks to see if any requested output channel names (stored in the OutList(:)) are invalid. It returns a +!! warning if any of the channels are not available outputs from the module. +!! It assigns the settings for OutParam(:) (i.e, the index, name, and units of the output channels, WriteOutput(:)). +!! the sign is set to 0 if the channel is invalid. +!! It sets assumes the value p%NumOuts has been set before this routine has been called, and it sets the values of p%OutParam here. +!! +!! This routine was generated by Write_ChckOutLst.m using the parameters listed in OutListParameters.xlsx at 12-Dec-2017 22:08:06. +SUBROUTINE BldNdOuts_SetOutParam(BldNd_OutList, p, ErrStat, ErrMsg ) +!.................................................................................................................................. + + IMPLICIT NONE + + ! Passed variables + + CHARACTER(ChanLen), INTENT(IN) :: BldNd_OutList(:) !< The list out user-requested outputs + TYPE(AD_ParameterType), INTENT(INOUT) :: p !< The module parameters + INTEGER(IntKi), INTENT(OUT) :: ErrStat !< The error status code + CHARACTER(*), INTENT(OUT) :: ErrMsg !< The error message, if an error occurred + + ! Local variables + + INTEGER :: ErrStat2 ! temporary (local) error status + INTEGER :: I ! Generic loop-counting index + INTEGER :: J ! Generic loop-counting index + INTEGER :: INDX ! Index for valid arrays + + LOGICAL :: InvalidOutput(1:BldNd_MaxOutPts) ! This array determines if the output channel is valid for this configuration + CHARACTER(ChanLen) :: OutListTmp ! A string to temporarily hold OutList(I) + CHARACTER(*), PARAMETER :: RoutineName = "BldNdOuts_SetOutParam" + + CHARACTER(OutStrLenM1), PARAMETER :: ValidParamAry(41) = (/ & ! This lists the names of the allowed parameters, which must be sorted alphabetically + "ALPHA ","AXIND ","CD ","CHI ", & + "CL ","CLRNC ","CM ","CN ","CT ","CURVE ","CX ","CY ","DYNP ", & + "FD ","FL ","FN ","FT ","FX ","FY ","GEOMPHI ","M ","MM ", & + "PHI ","RE ","STVX ", & + "STVY ","STVZ ","THETA ","TNIND ","UA_FLAG ", & + "VDISX ","VDISY ","VDISZ ","VINDX ","VINDY ","VREL ","VUNDX ","VUNDY ","VUNDZ ", & + "VX ","VY "/) + INTEGER(IntKi), PARAMETER :: ParamIndxAry(41) = (/ & ! This lists the index into AllOuts(:) of the allowed parameters ValidParamAry(:) + BldNd_Alpha , BldNd_AxInd , BldNd_Cd , BldNd_Chi , & + BldNd_Cl , BldNd_Clrnc , BldNd_Cm , BldNd_Cn , BldNd_Ct , BldNd_Curve , BldNd_Cx , BldNd_Cy , BldNd_DynP , & + BldNd_Fd , BldNd_Fl , BldNd_Fn , BldNd_Ft , BldNd_Fx , BldNd_Fy , BldNd_GeomPhi , BldNd_M , BldNd_Mm , & + BldNd_Phi , BldNd_Re , BldNd_STVx , & + BldNd_STVy , BldNd_STVz , BldNd_Theta , BldNd_TnInd , BldNd_UA_Flag , & + BldNd_VDisx , BldNd_VDisy , BldNd_VDisz , BldNd_Vindx , BldNd_Vindy , BldNd_VRel , BldNd_VUndx , BldNd_VUndy , BldNd_VUndz , & + BldNd_Vx , BldNd_Vy /) + CHARACTER(ChanLen), PARAMETER :: ParamUnitsAry(41) = (/ & ! This lists the units corresponding to the allowed parameters + "(deg) ","(-) ","(-) ","(deg) ", & + "(-) ","(m) ","(-) ","(-) ","(-) ","(deg) ","(-) ","(-) ","(Pa) ", & + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(1/0) ","(-) ","(N-m/m)", & + "(deg) ","(-) ","(m/s) ", & + "(m/s) ","(m/s) ","(deg) ","(-) ","(-) ", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & + "(m/s) ","(m/s) "/) + + + ! Initialize values + ErrStat = ErrID_None + ErrMsg = "" + InvalidOutput = .FALSE. + + +! ..... Developer must add checking for invalid inputs here: ..... + +! ................. End of validity checking ................. + + + !------------------------------------------------------------------------------------------------- + ! Allocate and set index, name, and units for the output channels + ! If a selected output channel is not available in this module, set error flag. + !------------------------------------------------------------------------------------------------- + + ALLOCATE ( p%BldNd_OutParam(1:p%BldNd_NumOuts) , STAT=ErrStat2 ) + IF ( ErrStat2 /= 0_IntKi ) THEN + CALL SetErrStat( ErrID_Fatal,"Error allocating memory for the AeroDyn BldNd_OutParam array.", ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + + + ! Set index, name, and units for all of the output channels. + ! If a selected output channel is not available by this module set ErrStat = ErrID_Warn. + + DO I = 1,p%BldNd_NumOuts + + p%BldNd_OutParam(I)%Name = BldNd_OutList(I) + OutListTmp = BldNd_OutList(I) + p%BldNd_OutParam(I)%SignM = 1 ! this won't be used + + CALL Conv2UC( OutListTmp ) ! Convert OutListTmp to upper case + + + Indx = IndexCharAry( OutListTmp(1:OutStrLenM1), ValidParamAry ) + + IF ( Indx > 0 ) THEN ! we found the channel name + IF ( InvalidOutput( ParamIndxAry(Indx) ) ) THEN ! but, it isn't valid for these settings + p%BldNd_OutParam(I)%Indx = 0 ! pick any valid channel (I just picked "Time=0" here because it's universal) + p%BldNd_OutParam(I)%Units = "INVALID" + p%BldNd_OutParam(I)%SignM = 0 + ELSE + p%BldNd_OutParam(I)%Indx = ParamIndxAry(Indx) + p%BldNd_OutParam(I)%Units = ParamUnitsAry(Indx) ! it's a valid output + END IF + ELSE ! this channel isn't valid + p%BldNd_OutParam(I)%Indx = 0 ! pick any valid channel (I just picked "Time=0" here because it's universal) + p%BldNd_OutParam(I)%Units = "INVALID" + p%BldNd_OutParam(I)%SignM = 0 ! multiply all results by zero + + CALL SetErrStat(ErrID_Fatal, TRIM(p%BldNd_OutParam(I)%Name)//" is not an available output channel.",ErrStat,ErrMsg,RoutineName) + END IF + + END DO + + RETURN +END SUBROUTINE BldNdOuts_SetOutParam +!---------------------------------------------------------------------------------------------------------------------------------- +!End of code generated by Matlab script +!********************************************************************************************************************************** + +END MODULE AeroDyn_AllBldNdOuts_IO diff --git a/modules/aerodyn/src/AeroDyn_Driver_Subs.f90 b/modules/aerodyn/src/AeroDyn_Driver_Subs.f90 index b06c2267e8..c29920e573 100644 --- a/modules/aerodyn/src/AeroDyn_Driver_Subs.f90 +++ b/modules/aerodyn/src/AeroDyn_Driver_Subs.f90 @@ -250,7 +250,7 @@ subroutine Set_AD_Inputs(iCase,nt,DvrData,AD,errStat,errMsg) AD%u(1)%HubMotion%RotationVel( :,1) = AD%u(1)%HubMotion%Orientation(1,:,1) * DvrData%Cases(iCase)%RotSpeed - ! Blade root motions: + ! Blade motions: do k=1,DvrData%numBlades theta(1) = (k-1)*TwoPi/real(DvrData%numBlades,ReKi) theta(2) = DvrData%precone @@ -261,7 +261,7 @@ subroutine Set_AD_Inputs(iCase,nt,DvrData,AD,errStat,errMsg) end do !k=numBlades - ! Blade motions: + ! Blade and blade root motions: do k=1,DvrData%numBlades rotateMat = transpose( AD%u(1)%BladeRootMotion(k)%Orientation( :,:,1) ) rotateMat = matmul( rotateMat, AD%u(1)%BladeRootMotion(k)%RefOrientation( :,:,1) ) @@ -271,6 +271,14 @@ subroutine Set_AD_Inputs(iCase,nt,DvrData,AD,errStat,errMsg) rotateMat(2,2) = rotateMat(2,2) - 1.0_ReKi rotateMat(3,3) = rotateMat(3,3) - 1.0_ReKi + + position = AD%u(1)%BladeRootMotion(k)%Position(:,1) - AD%u(1)%HubMotion%Position(:,1) + AD%u(1)%BladeRootMotion(k)%TranslationDisp(:,1) = AD%u(1)%HubMotion%TranslationDisp(:,1) + matmul( rotateMat, position ) + + position = AD%u(1)%BladeRootMotion(k)%Position(:,1) + AD%u(1)%BladeRootMotion(k)%TranslationDisp(:,1) & + - AD%u(1)%HubMotion%Position(:,1) - AD%u(1)%HubMotion%TranslationDisp(:,1) + AD%u(1)%BladeRootMotion(k)%TranslationVel( :,1) = cross_product( AD%u(1)%HubMotion%RotationVel(:,1), position ) + do j=1,AD%u(1)%BladeMotion(k)%nnodes position = AD%u(1)%BladeMotion(k)%Position(:,j) - AD%u(1)%HubMotion%Position(:,1) AD%u(1)%BladeMotion(k)%TranslationDisp(:,j) = AD%u(1)%HubMotion%TranslationDisp(:,1) + matmul( rotateMat, position ) @@ -450,6 +458,7 @@ subroutine Dvr_ReadInputFile(fileName, DvrData, errStat, errMsg ) call setErrStat( errStat2, ErrMsg2 , errStat, ErrMsg , RoutineName ) call ReadVar ( unIn, fileName, DvrData%OutFileData%Root, 'OutFileRoot', 'Root name for any output files', errStat2, errMsg2, UnEc ) call setErrStat( errStat2, ErrMsg2 , errStat, ErrMsg , RoutineName ) + IF ( PathIsRelative( DvrData%OutFileData%Root ) ) DvrData%OutFileData%Root = TRIM(PriPath)//TRIM(DvrData%OutFileData%Root) if (len_trim(DvrData%OutFileData%Root) == 0) then call getroot(fileName,DvrData%OutFileData%Root) end if diff --git a/modules/aerodyn/src/AeroDyn_Driver_Types.f90 b/modules/aerodyn/src/AeroDyn_Driver_Types.f90 index b6d95ded58..a8ea597818 100644 --- a/modules/aerodyn/src/AeroDyn_Driver_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Driver_Types.f90 @@ -194,20 +194,20 @@ SUBROUTINE AD_Dvr_PackDvr_Case( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WndSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ShearExp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RotSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Pitch - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Yaw - Re_Xferred = Re_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%dT - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%Tmax - Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WndSpeed + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%ShearExp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RotSpeed + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Pitch + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Yaw + Re_Xferred = Re_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%dT + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%Tmax + Db_Xferred = Db_Xferred + 1 END SUBROUTINE AD_Dvr_PackDvr_Case SUBROUTINE AD_Dvr_UnPackDvr_Case( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -223,12 +223,6 @@ SUBROUTINE AD_Dvr_UnPackDvr_Case( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -243,20 +237,20 @@ SUBROUTINE AD_Dvr_UnPackDvr_Case( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%WndSpeed = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%ShearExp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RotSpeed = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Pitch = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Yaw = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%dT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%Tmax = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%WndSpeed = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%ShearExp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RotSpeed = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Pitch = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Yaw = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%dT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%Tmax = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 END SUBROUTINE AD_Dvr_UnPackDvr_Case SUBROUTINE AD_Dvr_CopyDvr_OutputFile( SrcDvr_OutputFileData, DstDvr_OutputFileData, CtrlCode, ErrStat, ErrMsg ) @@ -449,24 +443,24 @@ SUBROUTINE AD_Dvr_PackDvr_OutputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%unOutFile - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%delim) - IntKiBuf(Int_Xferred) = ICHAR(InData%delim(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%outFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%outFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%Root) - IntKiBuf(Int_Xferred) = ICHAR(InData%Root(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%runTitle) - IntKiBuf(Int_Xferred) = ICHAR(InData%runTitle(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + IntKiBuf(Int_Xferred) = InData%unOutFile + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%delim) + IntKiBuf(Int_Xferred) = ICHAR(InData%delim(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%outFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%outFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%Root) + IntKiBuf(Int_Xferred) = ICHAR(InData%Root(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%runTitle) + IntKiBuf(Int_Xferred) = ICHAR(InData%runTitle(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( .NOT. ALLOCATED(InData%WriteOutputHdr) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -477,12 +471,12 @@ SUBROUTINE AD_Dvr_PackDvr_OutputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -494,12 +488,12 @@ SUBROUTINE AD_Dvr_PackDvr_OutputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF END SUBROUTINE AD_Dvr_PackDvr_OutputFile @@ -516,12 +510,6 @@ SUBROUTINE AD_Dvr_UnPackDvr_OutputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -576,24 +564,24 @@ SUBROUTINE AD_Dvr_UnPackDvr_OutputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%unOutFile = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%delim) - OutData%delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%outFmt) - OutData%outFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Root) - OutData%Root(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%runTitle) - OutData%runTitle(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + OutData%unOutFile = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%delim) + OutData%delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%outFmt) + OutData%outFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%Root) + OutData%Root(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%runTitle) + OutData%runTitle(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputHdr not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -607,19 +595,12 @@ SUBROUTINE AD_Dvr_UnPackDvr_OutputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated Int_Xferred = Int_Xferred + 1 @@ -634,19 +615,12 @@ SUBROUTINE AD_Dvr_UnPackDvr_OutputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF END SUBROUTINE AD_Dvr_UnPackDvr_OutputFile @@ -1143,8 +1117,10 @@ SUBROUTINE AD_Dvr_PackAeroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%InputTime))-1 ) = PACK(InData%InputTime,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%InputTime) + DO i1 = LBOUND(InData%InputTime,1), UBOUND(InData%InputTime,1) + DbKiBuf(Db_Xferred) = InData%InputTime(i1) + Db_Xferred = Db_Xferred + 1 + END DO END SUBROUTINE AD_Dvr_PackAeroDyn_Data SUBROUTINE AD_Dvr_UnPackAeroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1160,12 +1136,6 @@ SUBROUTINE AD_Dvr_UnPackAeroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1506,15 +1476,10 @@ SUBROUTINE AD_Dvr_UnPackAeroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) i1_l = LBOUND(OutData%InputTime,1) i1_u = UBOUND(OutData%InputTime,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%InputTime = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%InputTime))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%InputTime) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%InputTime,1), UBOUND(OutData%InputTime,1) + OutData%InputTime(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO END SUBROUTINE AD_Dvr_UnPackAeroDyn_Data SUBROUTINE AD_Dvr_CopyDvr_SimData( SrcDvr_SimDataData, DstDvr_SimDataData, CtrlCode, ErrStat, ErrMsg ) @@ -1690,24 +1655,24 @@ SUBROUTINE AD_Dvr_PackDvr_SimData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%AD_InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%AD_InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%numBlades - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%hubRad - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%hubHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%overhang - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ShftTilt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Precone - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumCases - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%AD_InputFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%AD_InputFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%numBlades + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%hubRad + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%hubHt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%overhang + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%ShftTilt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Precone + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumCases + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%Cases) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1792,12 +1757,6 @@ SUBROUTINE AD_Dvr_UnPackDvr_SimData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1812,24 +1771,24 @@ SUBROUTINE AD_Dvr_UnPackDvr_SimData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%AD_InputFile) - OutData%AD_InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%numBlades = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%hubRad = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%hubHt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%overhang = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%ShftTilt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Precone = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NumCases = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%AD_InputFile) + OutData%AD_InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%numBlades = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%hubRad = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%hubHt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%overhang = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%ShftTilt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Precone = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NumCases = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cases not allocated Int_Xferred = Int_Xferred + 1 ELSE diff --git a/modules/aerodyn/src/AeroDyn_IO.f90 b/modules/aerodyn/src/AeroDyn_IO.f90 index 09d924c45b..1e471bded2 100644 --- a/modules/aerodyn/src/AeroDyn_IO.f90 +++ b/modules/aerodyn/src/AeroDyn_IO.f90 @@ -24,6 +24,7 @@ MODULE AeroDyn_IO use AeroDyn_Types use BEMTUncoupled, only : SkewMod_Uncoupled, SkewMod_PittPeters, VelocityIsZero + USE AeroDyn_AllBldNdOuts_IO implicit none @@ -1511,81 +1512,6 @@ MODULE AeroDyn_IO contains -!---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE Calc_WriteDbgOutput( p, u, m, y, ErrStat, ErrMsg ) - - TYPE(AD_ParameterType), INTENT(IN ) :: p ! The module parameters - TYPE(AD_InputType), INTENT(IN ) :: u ! inputs - TYPE(AD_MiscVarType), INTENT(INOUT) :: m ! misc variables - TYPE(AD_OutputType), INTENT(IN ) :: y ! outputs - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! The error status code - CHARACTER(*), INTENT( OUT) :: ErrMsg ! The error message, if an error occurred - - ! local variables - integer, parameter :: indx = 1 ! m%BEMT_u(1) is at t; m%BEMT_u(2) is t+dt - CHARACTER(*), PARAMETER :: RoutineName = 'Calc_WriteOutput' - !INTEGER(intKi) :: ErrStat2 - !CHARACTER(ErrMsgLen) :: ErrMsg2 - - INTEGER(IntKi) :: j,k,i - REAL(ReKi) :: ct, st ! cosine, sine of theta - REAL(ReKi) :: cp, sp ! cosine, sine of phi - - - - ! start routine: - ErrStat = ErrID_None - ErrMsg = "" - - - - ! blade outputs - do k=1,p%numBlades - - ! m%AllOuts( BPitch( k) ) = calculated in SetInputsForBEMT - - do j=1,p%NumBlNds - - i = (k-1)*p%NumBlNds*23 + (j-1)*23 + 1 - - m%AllOuts( i ) = m%BEMT_u(indx)%theta(j,k)*R2D - m%AllOuts( i+1 ) = m%BEMT_u(indx)%psi(k)*R2D - m%AllOuts( i+2 ) = -m%BEMT_u(indx)%Vx(j,k) - m%AllOuts( i+3 ) = m%BEMT_u(indx)%Vy(j,k) - - m%AllOuts( i+4 ) = m%BEMT_y%axInduction(j,k) - m%AllOuts( i+5 ) = m%BEMT_y%tanInduction(j,k) - m%AllOuts( i+6 ) = m%BEMT_y%Vrel(j,k) - m%AllOuts( i+7 ) = m%BEMT_y%phi(j,k)*R2D - m%AllOuts( i+8 ) = (m%BEMT_y%phi(j,k) - m%BEMT_u(indx)%theta(j,k))*R2D - - - m%AllOuts( i+9 ) = m%BEMT_y%Cl(j,k) - m%AllOuts( i+10 ) = m%BEMT_y%Cd(j,k) - m%AllOuts( i+11 ) = m%BEMT_y%Cm(j,k) - m%AllOuts( i+12 ) = m%BEMT_y%Cx(j,k) - m%AllOuts( i+13 ) = m%BEMT_y%Cy(j,k) - - ct=cos(m%BEMT_u(indx)%theta(j,k)) - st=sin(m%BEMT_u(indx)%theta(j,k)) - m%AllOuts( i+14 ) = m%BEMT_y%Cx(j,k)*ct + m%BEMT_y%Cy(j,k)*st - m%AllOuts( i+15 ) = -m%BEMT_y%Cx(j,k)*st + m%BEMT_y%Cy(j,k)*ct - - cp=cos(m%BEMT_y%phi(j,k)) - sp=sin(m%BEMT_y%phi(j,k)) - m%AllOuts( i+16 ) = m%X(j,k)*cp - m%Y(j,k)*sp - m%AllOuts( i+17 ) = m%X(j,k)*sp + m%Y(j,k)*cp - m%AllOuts( i+18 ) = m%M(j,k) - m%AllOuts( i+19 ) = m%X(j,k) - m%AllOuts( i+20 ) = -m%Y(j,k) - m%AllOuts( i+21 ) = m%X(j,k)*ct - m%Y(j,k)*st - m%AllOuts( i+22 ) = -m%X(j,k)*st - m%Y(j,k)*ct - - end do ! nodes - end do ! blades - -END SUBROUTINE Calc_WriteDbgOutput - !---------------------------------------------------------------------------------------------------------------------------------- SUBROUTINE Calc_WriteOutput( p, u, m, y, OtherState, indx, ErrStat, ErrMsg ) @@ -1884,6 +1810,7 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, ADBlFile, OutFileRoot, UnE integer(IntKi) :: ErrStat2, IOS ! Temporary Error status logical :: Echo ! Determines if an echo file should be written character(ErrMsgLen) :: ErrMsg2 ! Temporary Error message + character(ErrMsgLen) :: ErrMsg_NoAllBldNdOuts ! Temporary Error message character(1024) :: PriPath ! Path name of the primary file character(1024) :: FTitle ! "File Title": the 2nd line of the input file, which contains a description of its contents character(200) :: Line ! Temporary storage of a line from the input file (to compare with "default") @@ -1901,7 +1828,11 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, ADBlFile, OutFileRoot, UnE CALL AllocAry( InputFileData%OutList, MaxOutPts, "Outlist", ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - + + ! Allocate array for holding the list of node outputs + CALL AllocAry( InputFileData%BldNd_OutList, BldNd_MaxOutPts, "BldNd_Outlist", ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! Get an available unit number for the file. CALL GetNewUnit( UnIn, ErrStat2, ErrMsg2 ) @@ -2157,8 +2088,8 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, ADBlFile, OutFileRoot, UnE CALL ReadCom( UnIn, InputFile, 'Section Header: Beddoes-Leishman Unsteady Airfoil Aerodynamics Options', ErrStat2, ErrMsg2, UnEc ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! UAMod - Unsteady Aero Model Switch (switch) {1=Baseline model (Original), 2=Gonzalez's variant (changes in Cn,Cc,Cm), 3=Minemma/Pierce variant (changes in Cc and Cm)} [used only when AFAreoMod=2] (-): - CALL ReadVar( UnIn, InputFile, InputFileData%UAMod, "UAMod", "Unsteady Aero Model Switch (switch) {1=Baseline model (Original), 2=Gonzalez's variant (changes in Cn,Cc,Cm), 3=Minemma/Pierce variant (changes in Cc and Cm)} [used only when AFAreoMod=2] (-)", ErrStat2, ErrMsg2, UnEc) + ! UAMod - Unsteady Aero Model Switch (switch) {1=Baseline model (Original), 2=Gonzalez's variant (changes in Cn,Cc,Cm), 3=Minnema/Pierce variant (changes in Cc and Cm)} [used only when AFAreoMod=2] (-): + CALL ReadVar( UnIn, InputFile, InputFileData%UAMod, "UAMod", "Unsteady Aero Model Switch (switch) {1=Baseline model (Original), 2=Gonzalez's variant (changes in Cn,Cc,Cm), 3=Minnema/Pierce variant (changes in Cc and Cm)} [used only when AFAreoMod=2] (-)", ErrStat2, ErrMsg2, UnEc) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! FLookup - Flag to indicate whether a lookup for f' will be calculated (TRUE) or whether best-fit exponential equations will be used (FALSE); if FALSE S1-S4 must be provided in airfoil input files [used only when AFAreoMod=2] (flag): @@ -2359,6 +2290,80 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, ADBlFile, OutFileRoot, UnE CALL ReadOutputList ( UnIn, InputFile, InputFileData%OutList, InputFileData%NumOuts, 'OutList', "List of user-requested output channels", ErrStat2, ErrMsg2, UnEc ) ! Routine in NWTC Subroutine Library CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! Return on error at end of section + IF ( ErrStat >= AbortErrLev ) THEN + CALL Cleanup() + RETURN + END IF + + !---------------------- END OF FILE ----------------------------------------- + + + + !----------- OUTLIST ----------------------------------------------------------- + ! In case there is something ill-formed in the additional nodal outputs section, we will simply ignore it. + ErrMsg_NoAllBldNdOuts='Nodal output section of AeroDyn input file not found or improperly formatted.' + + !----------- OUTLIST for BldNd ----------------------------------------------------------- + CALL ReadCom( UnIn, InputFile, 'Section Header: OutList for Blade node channels', ErrStat2, ErrMsg2, UnEc ) + IF ( ErrStat2 >= AbortErrLev ) THEN + InputFileData%BldNd_BladesOut = 0 + InputFileData%BldNd_NumOuts = 0 + call wrscr( trim(ErrMsg_NoAllBldNdOuts) ) + CALL Cleanup() + RETURN + ENDIF + + + ! Number of blade nodes to output: will modify this at some point for arrays + ! TODO: In a future release, allow this to be an array of N blade numbers (change BldNd_BladesOut to an array if we do that). + ! Will likely require reading this line in as a string (BldNd_BladesOut_Str) and parsing it + CALL ReadVar( UnIn, InputFile, InputFileData%BldNd_BladesOut, 'BldNd_BladesOut', 'Which blades to output node data on.'//TRIM(Num2Lstr(I)), ErrStat2, ErrMsg2, UnEc ) + IF ( ErrStat2 >= AbortErrLev ) THEN + InputFileData%BldNd_BladesOut = 0 + InputFileData%BldNd_NumOuts = 0 + call wrscr( trim(ErrMsg_NoAllBldNdOuts) ) + CALL Cleanup() + RETURN + ENDIF + + + ! Which blades to output for: will add this at some point + ! TODO: Parse this string into an array of nodes to output at (one idea is to set an array of boolean to T/F for which nodes to output). At present, we ignore it entirely. + CALL ReadVar( UnIn, InputFile, InputFileData%BldNd_BlOutNd_Str, 'BldNd_BlOutNd_Str', 'Which nodes to output node data on.'//TRIM(Num2Lstr(I)), ErrStat2, ErrMsg2, UnEc ) + IF ( ErrStat2 >= AbortErrLev ) THEN + InputFileData%BldNd_BladesOut = 0 + InputFileData%BldNd_NumOuts = 0 + call wrscr( trim(ErrMsg_NoAllBldNdOuts) ) + CALL Cleanup() + RETURN + ENDIF + + + ! Section header for outlist + CALL ReadCom( UnIn, InputFile, 'Section Header: OutList', ErrStat2, ErrMsg2, UnEc ) + IF ( ErrStat2 >= AbortErrLev ) THEN + InputFileData%BldNd_BladesOut = 0 + InputFileData%BldNd_NumOuts = 0 + call wrscr( trim(ErrMsg_NoAllBldNdOuts) ) + CALL Cleanup() + RETURN + ENDIF + + + ! OutList - List of user-requested output channels at each node(-): + CALL ReadOutputList ( UnIn, InputFile, InputFileData%BldNd_OutList, InputFileData%BldNd_NumOuts, 'OutList', "List of user-requested output channels", ErrStat2, ErrMsg2, UnEc ) ! Routine in NWTC Subroutine Library + IF ( ErrStat2 >= AbortErrLev ) THEN + InputFileData%BldNd_BladesOut = 0 + InputFileData%BldNd_NumOuts = 0 + call wrscr( trim(ErrMsg_NoAllBldNdOuts) ) + CALL Cleanup() + RETURN + ENDIF + + + !---------------------- END OF FILE ----------------------------------------- CALL Cleanup( ) @@ -2696,7 +2701,7 @@ SUBROUTINE AD_PrintSum( InputFileData, p, u, y, ErrStat, ErrMsg ) case (2) Msg = "Gonzalez's variant (changes in Cn, Cc, and Cm)" case (3) - Msg = 'Minemma/Pierce variant (changes in Cc and Cm)' + Msg = 'Minnema/Pierce variant (changes in Cc and Cm)' !case (4) ! Msg = 'DYSTOOL' case default @@ -2741,9 +2746,6 @@ SUBROUTINE AD_PrintSum( InputFileData, p, u, y, ErrStat, ErrMsg ) end if -#ifndef DBG_OUTS -! p%OutParam isn't allocated when DBG_OUTS is defined - OutPFmt = '( 15x, I4, 2X, A '//TRIM(Num2LStr(ChanLen))//',1 X, A'//TRIM(Num2LStr(ChanLen))//' )' WRITE (UnSu,'(15x,A)') 'Requested Output Channels:' WRITE (UnSu,'(15x,A)') 'Col Parameter Units' @@ -2752,7 +2754,15 @@ SUBROUTINE AD_PrintSum( InputFileData, p, u, y, ErrStat, ErrMsg ) DO I = 0,p%NumOuts WRITE (UnSu,OutPFmt) I, p%OutParam(I)%Name, p%OutParam(I)%Units END DO -#endif + + WRITE (UnSu,'(15x,A)') + WRITE (UnSu,'(15x,A)') + WRITE (UnSu,'(15x,A)') 'Requested Output Channels at each blade station:' + WRITE (UnSu,'(15x,A)') 'Col Parameter Units' + WRITE (UnSu,'(15x,A)') '---- -------------- -----' + DO I = 1,p%BldNd_NumOuts + WRITE (UnSu,OutPFmt) I, p%BldNd_OutParam(I)%Name, p%BldNd_OutParam(I)%Units + END DO CLOSE(UnSu) diff --git a/modules/aerodyn/src/AeroDyn_Registry.txt b/modules/aerodyn/src/AeroDyn_Registry.txt index fed1af801e..eef99eb9c4 100644 --- a/modules/aerodyn/src/AeroDyn_Registry.txt +++ b/modules/aerodyn/src/AeroDyn_Registry.txt @@ -83,7 +83,7 @@ typedef ^ AD_InputFile LOGICAL AIDrag - - - "Include the drag term in the axial- typedef ^ AD_InputFile LOGICAL TIDrag - - - "Include the drag term in the tangential-induction calculation? [unused when WakeMod=0 or TanInd=FALSE]" flag typedef ^ AD_InputFile ReKi IndToler - - - "Convergence tolerance for BEM induction factors [unused when WakeMod=0]" - typedef ^ AD_InputFile ReKi MaxIter - - - "Maximum number of iteration steps [unused when WakeMod=0]" - -typedef ^ AD_InputFile IntKi UAMod - - - "Unsteady Aero Model Switch (switch) {1=Baseline model (Original), 2=Gonzalez's variant (changes in Cn,Cc,Cm), 3=Minemma/Pierce variant (changes in Cc and Cm)} [used only when AFAeroMod=2]" - +typedef ^ AD_InputFile IntKi UAMod - - - "Unsteady Aero Model Switch (switch) {1=Baseline model (Original), 2=Gonzalez's variant (changes in Cn,Cc,Cm), 3=Minnema/Pierce variant (changes in Cc and Cm)} [used only when AFAeroMod=2]" - typedef ^ AD_InputFile LOGICAL FLookup - - - "Flag to indicate whether a lookup for f' will be calculated (TRUE) or whether best-fit exponential equations will be used (FALSE); if FALSE S1-S4 must be provided in airfoil input files [used only when AFAeroMod=2]" flag typedef ^ AD_InputFile ReKi InCol_Alfa - - - "The column in the airfoil tables that contains the angle of attack" - typedef ^ AD_InputFile ReKi InCol_Cl - - - "The column in the airfoil tables that contains the lift coefficient" - @@ -109,6 +109,12 @@ typedef ^ AD_InputFile IntKi NumOuts - - - "Number of parameters in the output l typedef ^ AD_InputFile CHARACTER(ChanLen) OutList {:} - - "List of user-requested output channels" - typedef ^ AD_InputFile ReKi tau1_const - - - "time constant for DBEMT [used only when WakeMod=2 and DBEMT_Mod=1]" s typedef ^ AD_InputFile IntKi DBEMT_Mod - - - "Type of dynamic BEMT (DBEMT) model {1=constant tau1, 2=time-dependent tau1}" - +typedef ^ AD_InputFile IntKi BldNd_NumOuts - - - "Number of requested output channels per blade node (AD_AllBldNdOuts)" - +typedef ^ AD_InputFile CHARACTER(ChanLen) BldNd_OutList {:} - - "List of user-requested output channels (AD_AllBldNdOuts)" - +#typedef ^ AD_InputFile IntKi BldNd_BlOutNd {:} - - "The blade nodes to actually output (AD_AllBldNdOuts)" - +typedef ^ AD_InputFile CHARACTER(1024) BldNd_BlOutNd_Str - - - "String to parse for the blade nodes to actually output (AD_AllBldNdOuts)" - +typedef ^ AD_InputFile IntKi BldNd_BladesOut - - - "The blades to output (AD_AllBldNdOuts)" - +#typedef ^ AD_InputFile CHARACTER(1024) BldNd_BladesOut_Str - - - "String to parse for the he blades to output (AD_AllBldNdOuts)" - # ..... States .................................................................................................................... # Define continuous (differentiable) states here: @@ -179,6 +185,14 @@ typedef ^ ParameterType IntKi NBlOuts - - - "Number of blade node outputs [0 - 9 typedef ^ ParameterType IntKi BlOutNd {9} - - "Blade nodes whose values will be output" - typedef ^ ParameterType IntKi NTwOuts - - - "Number of tower node outputs [0 - 9]" - typedef ^ ParameterType IntKi TwOutNd {9} - - "Tower nodes whose values will be output" - + +typedef ^ ParameterType IntKi BldNd_NumOuts - - - "Number of requested output channels per blade node (AD_AllBldNdOuts)" - +typedef ^ ParameterType IntKi BldNd_TotNumOuts - - - "Total number of requested output channels of blade node information (BldNd_NumOuts * BldNd_BlOutNd * BldNd_BladesOut -- AD_AllBldNdOuts)" - +typedef ^ ParameterType OutParmType BldNd_OutParam {:} - - "Names and units (and other characteristics) of all requested output parameters" - +typedef ^ ParameterType IntKi BldNd_BlOutNd {:} - - "The blade nodes to actually output (AD_AllBldNdOuts)" - +typedef ^ ParameterType IntKi BldNd_BladesOut - - - "The blades to output (AD_AllBldNdOuts)" - + + typedef ^ ParameterType Integer Jac_u_indx {:}{:} - - "matrix to help fill/pack the u vector in computing the jacobian" - typedef ^ ParameterType ReKi du {:} - - "vector that determines size of perturbation for u (inputs)" typedef ^ ParameterType Integer Jac_ny - - - "number of outputs in jacobian matrix" - diff --git a/modules/aerodyn/src/AeroDyn_Types.f90 b/modules/aerodyn/src/AeroDyn_Types.f90 index 223b9724fc..1c921c6754 100644 --- a/modules/aerodyn/src/AeroDyn_Types.f90 +++ b/modules/aerodyn/src/AeroDyn_Types.f90 @@ -111,7 +111,7 @@ MODULE AeroDyn_Types LOGICAL :: TIDrag !< Include the drag term in the tangential-induction calculation? [unused when WakeMod=0 or TanInd=FALSE] [flag] REAL(ReKi) :: IndToler !< Convergence tolerance for BEM induction factors [unused when WakeMod=0] [-] REAL(ReKi) :: MaxIter !< Maximum number of iteration steps [unused when WakeMod=0] [-] - INTEGER(IntKi) :: UAMod !< Unsteady Aero Model Switch (switch) {1=Baseline model (Original), 2=Gonzalez's variant (changes in Cn,Cc,Cm), 3=Minemma/Pierce variant (changes in Cc and Cm)} [used only when AFAeroMod=2] [-] + INTEGER(IntKi) :: UAMod !< Unsteady Aero Model Switch (switch) {1=Baseline model (Original), 2=Gonzalez's variant (changes in Cn,Cc,Cm), 3=Minnema/Pierce variant (changes in Cc and Cm)} [used only when AFAeroMod=2] [-] LOGICAL :: FLookup !< Flag to indicate whether a lookup for f' will be calculated (TRUE) or whether best-fit exponential equations will be used (FALSE); if FALSE S1-S4 must be provided in airfoil input files [used only when AFAeroMod=2] [flag] REAL(ReKi) :: InCol_Alfa !< The column in the airfoil tables that contains the angle of attack [-] REAL(ReKi) :: InCol_Cl !< The column in the airfoil tables that contains the lift coefficient [-] @@ -136,6 +136,10 @@ MODULE AeroDyn_Types CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutList !< List of user-requested output channels [-] REAL(ReKi) :: tau1_const !< time constant for DBEMT [used only when WakeMod=2 and DBEMT_Mod=1] [s] INTEGER(IntKi) :: DBEMT_Mod !< Type of dynamic BEMT (DBEMT) model {1=constant tau1, 2=time-dependent tau1} [-] + INTEGER(IntKi) :: BldNd_NumOuts !< Number of requested output channels per blade node (AD_AllBldNdOuts) [-] + CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: BldNd_OutList !< List of user-requested output channels (AD_AllBldNdOuts) [-] + CHARACTER(1024) :: BldNd_BlOutNd_Str !< String to parse for the blade nodes to actually output (AD_AllBldNdOuts) [-] + INTEGER(IntKi) :: BldNd_BladesOut !< The blades to output (AD_AllBldNdOuts) [-] END TYPE AD_InputFile ! ======================= ! ========= AD_ContinuousStateType ======= @@ -214,6 +218,11 @@ MODULE AeroDyn_Types INTEGER(IntKi) , DIMENSION(1:9) :: BlOutNd !< Blade nodes whose values will be output [-] INTEGER(IntKi) :: NTwOuts !< Number of tower node outputs [0 - 9] [-] INTEGER(IntKi) , DIMENSION(1:9) :: TwOutNd !< Tower nodes whose values will be output [-] + INTEGER(IntKi) :: BldNd_NumOuts !< Number of requested output channels per blade node (AD_AllBldNdOuts) [-] + INTEGER(IntKi) :: BldNd_TotNumOuts !< Total number of requested output channels of blade node information (BldNd_NumOuts * BldNd_BlOutNd * BldNd_BladesOut -- AD_AllBldNdOuts) [-] + TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: BldNd_OutParam !< Names and units (and other characteristics) of all requested output parameters [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: BldNd_BlOutNd !< The blade nodes to actually output (AD_AllBldNdOuts) [-] + INTEGER(IntKi) :: BldNd_BladesOut !< The blades to output (AD_AllBldNdOuts) [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Jac_u_indx !< matrix to help fill/pack the u vector in computing the jacobian [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: du !< vector that determines size of perturbation for u (inputs) [-] INTEGER(IntKi) :: Jac_ny !< number of outputs in jacobian matrix [-] @@ -391,24 +400,30 @@ SUBROUTINE AD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Linearize , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumBlades - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%HubPosition))-1 ) = PACK(InData%HubPosition,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%HubPosition) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%HubOrientation))-1 ) = PACK(InData%HubOrientation,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%HubOrientation) + DO I = 1, LEN(InData%InputFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%Linearize, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumBlades + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Gravity + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO i1 = LBOUND(InData%HubPosition,1), UBOUND(InData%HubPosition,1) + ReKiBuf(Re_Xferred) = InData%HubPosition(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i2 = LBOUND(InData%HubOrientation,2), UBOUND(InData%HubOrientation,2) + DO i1 = LBOUND(InData%HubOrientation,1), UBOUND(InData%HubOrientation,1) + DbKiBuf(Db_Xferred) = InData%HubOrientation(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO IF ( .NOT. ALLOCATED(InData%BladeRootPosition) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -422,8 +437,12 @@ SUBROUTINE AD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeRootPosition,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BladeRootPosition)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BladeRootPosition))-1 ) = PACK(InData%BladeRootPosition,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BladeRootPosition) + DO i2 = LBOUND(InData%BladeRootPosition,2), UBOUND(InData%BladeRootPosition,2) + DO i1 = LBOUND(InData%BladeRootPosition,1), UBOUND(InData%BladeRootPosition,1) + ReKiBuf(Re_Xferred) = InData%BladeRootPosition(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%BladeRootOrientation) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -441,8 +460,14 @@ SUBROUTINE AD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BladeRootOrientation,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BladeRootOrientation)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%BladeRootOrientation))-1 ) = PACK(InData%BladeRootOrientation,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%BladeRootOrientation) + DO i3 = LBOUND(InData%BladeRootOrientation,3), UBOUND(InData%BladeRootOrientation,3) + DO i2 = LBOUND(InData%BladeRootOrientation,2), UBOUND(InData%BladeRootOrientation,2) + DO i1 = LBOUND(InData%BladeRootOrientation,1), UBOUND(InData%BladeRootOrientation,1) + DbKiBuf(Db_Xferred) = InData%BladeRootOrientation(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF END SUBROUTINE AD_PackInitInput @@ -459,12 +484,6 @@ SUBROUTINE AD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (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 @@ -482,44 +501,36 @@ SUBROUTINE AD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%InputFile) - OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%Linearize = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NumBlades = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%Gravity = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%InputFile) + OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%Linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%Linearize) + Int_Xferred = Int_Xferred + 1 + OutData%NumBlades = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%Gravity = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I i1_l = LBOUND(OutData%HubPosition,1) i1_u = UBOUND(OutData%HubPosition,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%HubPosition = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%HubPosition))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%HubPosition) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%HubPosition,1), UBOUND(OutData%HubPosition,1) + OutData%HubPosition(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%HubOrientation,1) i1_u = UBOUND(OutData%HubOrientation,1) i2_l = LBOUND(OutData%HubOrientation,2) i2_u = UBOUND(OutData%HubOrientation,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%HubOrientation = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%HubOrientation))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%HubOrientation) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%HubOrientation,2), UBOUND(OutData%HubOrientation,2) + DO i1 = LBOUND(OutData%HubOrientation,1), UBOUND(OutData%HubOrientation,1) + OutData%HubOrientation(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeRootPosition not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -536,15 +547,12 @@ SUBROUTINE AD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootPosition.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%BladeRootPosition)>0) OutData%BladeRootPosition = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BladeRootPosition))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BladeRootPosition) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%BladeRootPosition,2), UBOUND(OutData%BladeRootPosition,2) + DO i1 = LBOUND(OutData%BladeRootPosition,1), UBOUND(OutData%BladeRootPosition,1) + OutData%BladeRootPosition(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeRootOrientation not allocated Int_Xferred = Int_Xferred + 1 @@ -565,15 +573,14 @@ SUBROUTINE AD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BladeRootOrientation.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%BladeRootOrientation)>0) OutData%BladeRootOrientation = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%BladeRootOrientation))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%BladeRootOrientation) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%BladeRootOrientation,3), UBOUND(OutData%BladeRootOrientation,3) + DO i2 = LBOUND(OutData%BladeRootOrientation,2), UBOUND(OutData%BladeRootOrientation,2) + DO i1 = LBOUND(OutData%BladeRootOrientation,1), UBOUND(OutData%BladeRootOrientation,1) + OutData%BladeRootOrientation(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF END SUBROUTINE AD_UnPackInitInput @@ -809,8 +816,8 @@ SUBROUTINE AD_PackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumBlNds - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumBlNds + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%BlSpn) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -821,8 +828,10 @@ SUBROUTINE AD_PackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlSpn,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BlSpn)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlSpn))-1 ) = PACK(InData%BlSpn,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlSpn) + DO i1 = LBOUND(InData%BlSpn,1), UBOUND(InData%BlSpn,1) + ReKiBuf(Re_Xferred) = InData%BlSpn(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%BlCrvAC) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -834,8 +843,10 @@ SUBROUTINE AD_PackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlCrvAC,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BlCrvAC)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlCrvAC))-1 ) = PACK(InData%BlCrvAC,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlCrvAC) + DO i1 = LBOUND(InData%BlCrvAC,1), UBOUND(InData%BlCrvAC,1) + ReKiBuf(Re_Xferred) = InData%BlCrvAC(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%BlSwpAC) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -847,8 +858,10 @@ SUBROUTINE AD_PackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlSwpAC,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BlSwpAC)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlSwpAC))-1 ) = PACK(InData%BlSwpAC,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlSwpAC) + DO i1 = LBOUND(InData%BlSwpAC,1), UBOUND(InData%BlSwpAC,1) + ReKiBuf(Re_Xferred) = InData%BlSwpAC(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%BlCrvAng) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -860,8 +873,10 @@ SUBROUTINE AD_PackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlCrvAng,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BlCrvAng)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlCrvAng))-1 ) = PACK(InData%BlCrvAng,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlCrvAng) + DO i1 = LBOUND(InData%BlCrvAng,1), UBOUND(InData%BlCrvAng,1) + ReKiBuf(Re_Xferred) = InData%BlCrvAng(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%BlTwist) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -873,8 +888,10 @@ SUBROUTINE AD_PackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlTwist,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BlTwist)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlTwist))-1 ) = PACK(InData%BlTwist,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlTwist) + DO i1 = LBOUND(InData%BlTwist,1), UBOUND(InData%BlTwist,1) + ReKiBuf(Re_Xferred) = InData%BlTwist(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%BlChord) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -886,8 +903,10 @@ SUBROUTINE AD_PackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlChord,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BlChord)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlChord))-1 ) = PACK(InData%BlChord,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlChord) + DO i1 = LBOUND(InData%BlChord,1), UBOUND(InData%BlChord,1) + ReKiBuf(Re_Xferred) = InData%BlChord(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%BlAFID) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -899,8 +918,10 @@ SUBROUTINE AD_PackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlAFID,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BlAFID)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%BlAFID))-1 ) = PACK(InData%BlAFID,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%BlAFID) + DO i1 = LBOUND(InData%BlAFID,1), UBOUND(InData%BlAFID,1) + IntKiBuf(Int_Xferred) = InData%BlAFID(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF END SUBROUTINE AD_PackBladePropsType @@ -917,12 +938,6 @@ SUBROUTINE AD_UnPackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -937,8 +952,8 @@ SUBROUTINE AD_UnPackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%NumBlNds = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NumBlNds = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlSpn not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -952,15 +967,10 @@ SUBROUTINE AD_UnPackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlSpn.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BlSpn)>0) OutData%BlSpn = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlSpn))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlSpn) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BlSpn,1), UBOUND(OutData%BlSpn,1) + OutData%BlSpn(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlCrvAC not allocated Int_Xferred = Int_Xferred + 1 @@ -975,15 +985,10 @@ SUBROUTINE AD_UnPackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlCrvAC.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BlCrvAC)>0) OutData%BlCrvAC = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlCrvAC))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlCrvAC) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BlCrvAC,1), UBOUND(OutData%BlCrvAC,1) + OutData%BlCrvAC(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlSwpAC not allocated Int_Xferred = Int_Xferred + 1 @@ -998,15 +1003,10 @@ SUBROUTINE AD_UnPackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlSwpAC.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BlSwpAC)>0) OutData%BlSwpAC = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlSwpAC))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlSwpAC) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BlSwpAC,1), UBOUND(OutData%BlSwpAC,1) + OutData%BlSwpAC(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlCrvAng not allocated Int_Xferred = Int_Xferred + 1 @@ -1021,15 +1021,10 @@ SUBROUTINE AD_UnPackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlCrvAng.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BlCrvAng)>0) OutData%BlCrvAng = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlCrvAng))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlCrvAng) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BlCrvAng,1), UBOUND(OutData%BlCrvAng,1) + OutData%BlCrvAng(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlTwist not allocated Int_Xferred = Int_Xferred + 1 @@ -1044,15 +1039,10 @@ SUBROUTINE AD_UnPackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlTwist.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BlTwist)>0) OutData%BlTwist = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlTwist))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlTwist) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BlTwist,1), UBOUND(OutData%BlTwist,1) + OutData%BlTwist(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlChord not allocated Int_Xferred = Int_Xferred + 1 @@ -1067,15 +1057,10 @@ SUBROUTINE AD_UnPackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlChord.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BlChord)>0) OutData%BlChord = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlChord))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlChord) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BlChord,1), UBOUND(OutData%BlChord,1) + OutData%BlChord(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlAFID not allocated Int_Xferred = Int_Xferred + 1 @@ -1090,15 +1075,10 @@ SUBROUTINE AD_UnPackBladePropsType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlAFID.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BlAFID)>0) OutData%BlAFID = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%BlAFID))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%BlAFID) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BlAFID,1), UBOUND(OutData%BlAFID,1) + OutData%BlAFID(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF END SUBROUTINE AD_UnPackBladePropsType @@ -1234,8 +1214,14 @@ SUBROUTINE AD_PackBladeShape( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AirfoilCoords,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AirfoilCoords)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AirfoilCoords))-1 ) = PACK(InData%AirfoilCoords,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AirfoilCoords) + DO i3 = LBOUND(InData%AirfoilCoords,3), UBOUND(InData%AirfoilCoords,3) + DO i2 = LBOUND(InData%AirfoilCoords,2), UBOUND(InData%AirfoilCoords,2) + DO i1 = LBOUND(InData%AirfoilCoords,1), UBOUND(InData%AirfoilCoords,1) + ReKiBuf(Re_Xferred) = InData%AirfoilCoords(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF END SUBROUTINE AD_PackBladeShape @@ -1252,12 +1238,6 @@ SUBROUTINE AD_UnPackBladeShape( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (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 @@ -1293,15 +1273,14 @@ SUBROUTINE AD_UnPackBladeShape( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AirfoilCoords.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%AirfoilCoords)>0) OutData%AirfoilCoords = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AirfoilCoords))-1 ), mask3, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%AirfoilCoords) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%AirfoilCoords,3), UBOUND(OutData%AirfoilCoords,3) + DO i2 = LBOUND(OutData%AirfoilCoords,2), UBOUND(OutData%AirfoilCoords,2) + DO i1 = LBOUND(OutData%AirfoilCoords,1), UBOUND(OutData%AirfoilCoords,1) + OutData%AirfoilCoords(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF END SUBROUTINE AD_UnPackBladeShape @@ -1739,12 +1718,12 @@ SUBROUTINE AD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1756,12 +1735,12 @@ SUBROUTINE AD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + 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) @@ -1791,8 +1770,8 @@ SUBROUTINE AD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AirDens - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AirDens + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%BladeShape) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1844,12 +1823,12 @@ SUBROUTINE AD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_y,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%LinNames_y,1), UBOUND(InData%LinNames_y,1) + DO 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LinNames_z) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1861,12 +1840,12 @@ SUBROUTINE AD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_z,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%LinNames_z,1), UBOUND(InData%LinNames_z,1) + DO i1 = LBOUND(InData%LinNames_z,1), UBOUND(InData%LinNames_z,1) DO I = 1, LEN(InData%LinNames_z) IntKiBuf(Int_Xferred) = ICHAR(InData%LinNames_z(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LinNames_u) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1878,12 +1857,12 @@ SUBROUTINE AD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_u,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%LinNames_u,1), UBOUND(InData%LinNames_u,1) + DO 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%RotFrame_y) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1895,8 +1874,10 @@ SUBROUTINE AD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_y,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RotFrame_y)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%RotFrame_y)-1 ) = TRANSFER(PACK( InData%RotFrame_y ,.TRUE.), IntKiBuf(1), SIZE(InData%RotFrame_y)) - Int_Xferred = Int_Xferred + SIZE(InData%RotFrame_y) + DO i1 = LBOUND(InData%RotFrame_y,1), UBOUND(InData%RotFrame_y,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_y(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%RotFrame_z) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1908,8 +1889,10 @@ SUBROUTINE AD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_z,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RotFrame_z)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%RotFrame_z)-1 ) = TRANSFER(PACK( InData%RotFrame_z ,.TRUE.), IntKiBuf(1), SIZE(InData%RotFrame_z)) - Int_Xferred = Int_Xferred + SIZE(InData%RotFrame_z) + DO i1 = LBOUND(InData%RotFrame_z,1), UBOUND(InData%RotFrame_z,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_z(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%RotFrame_u) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1921,8 +1904,10 @@ SUBROUTINE AD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_u,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RotFrame_u)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%RotFrame_u)-1 ) = TRANSFER(PACK( InData%RotFrame_u ,.TRUE.), IntKiBuf(1), SIZE(InData%RotFrame_u)) - Int_Xferred = Int_Xferred + SIZE(InData%RotFrame_u) + 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 @@ -1934,8 +1919,10 @@ SUBROUTINE AD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IsLoad_u,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%IsLoad_u)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%IsLoad_u)-1 ) = TRANSFER(PACK( InData%IsLoad_u ,.TRUE.), IntKiBuf(1), SIZE(InData%IsLoad_u)) - Int_Xferred = Int_Xferred + SIZE(InData%IsLoad_u) + DO i1 = LBOUND(InData%IsLoad_u,1), UBOUND(InData%IsLoad_u,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%IsLoad_u(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%BladeProps) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1988,8 +1975,10 @@ SUBROUTINE AD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrElev,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwrElev)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwrElev))-1 ) = PACK(InData%TwrElev,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwrElev) + DO i1 = LBOUND(InData%TwrElev,1), UBOUND(InData%TwrElev,1) + ReKiBuf(Re_Xferred) = InData%TwrElev(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TwrDiam) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2001,8 +1990,10 @@ SUBROUTINE AD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrDiam,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwrDiam)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwrDiam))-1 ) = PACK(InData%TwrDiam,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwrDiam) + DO i1 = LBOUND(InData%TwrDiam,1), UBOUND(InData%TwrDiam,1) + ReKiBuf(Re_Xferred) = InData%TwrDiam(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE AD_PackInitOutput @@ -2019,12 +2010,6 @@ SUBROUTINE AD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -2052,19 +2037,12 @@ SUBROUTINE AD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated Int_Xferred = Int_Xferred + 1 @@ -2079,19 +2057,12 @@ SUBROUTINE AD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -2133,8 +2104,8 @@ SUBROUTINE AD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%AirDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%AirDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeShape not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -2204,19 +2175,12 @@ SUBROUTINE AD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%LinNames_y,1), UBOUND(OutData%LinNames_y,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_z not allocated Int_Xferred = Int_Xferred + 1 @@ -2231,19 +2195,12 @@ SUBROUTINE AD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_z.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%LinNames_z,1), UBOUND(OutData%LinNames_z,1) + DO i1 = LBOUND(OutData%LinNames_z,1), UBOUND(OutData%LinNames_z,1) DO I = 1, LEN(OutData%LinNames_z) OutData%LinNames_z(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_u not allocated Int_Xferred = Int_Xferred + 1 @@ -2258,19 +2215,12 @@ SUBROUTINE AD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%LinNames_u,1), UBOUND(OutData%LinNames_u,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_y not allocated Int_Xferred = Int_Xferred + 1 @@ -2285,15 +2235,10 @@ SUBROUTINE AD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%RotFrame_y)>0) OutData%RotFrame_y = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%RotFrame_y))-1 ), OutData%RotFrame_y), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%RotFrame_y) - DEALLOCATE(mask1) + 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_z not allocated Int_Xferred = Int_Xferred + 1 @@ -2308,15 +2253,10 @@ SUBROUTINE AD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_z.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%RotFrame_z)>0) OutData%RotFrame_z = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%RotFrame_z))-1 ), OutData%RotFrame_z), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%RotFrame_z) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%RotFrame_z,1), UBOUND(OutData%RotFrame_z,1) + OutData%RotFrame_z(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_z(i1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_u not allocated Int_Xferred = Int_Xferred + 1 @@ -2331,15 +2271,10 @@ SUBROUTINE AD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%RotFrame_u)>0) OutData%RotFrame_u = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%RotFrame_u))-1 ), OutData%RotFrame_u), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%RotFrame_u) - DEALLOCATE(mask1) + 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 @@ -2354,15 +2289,10 @@ SUBROUTINE AD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%IsLoad_u)>0) OutData%IsLoad_u = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%IsLoad_u))-1 ), OutData%IsLoad_u), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%IsLoad_u) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%IsLoad_u,1), UBOUND(OutData%IsLoad_u,1) + OutData%IsLoad_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsLoad_u(i1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeProps not allocated Int_Xferred = Int_Xferred + 1 @@ -2433,15 +2363,10 @@ SUBROUTINE AD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrElev.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwrElev)>0) OutData%TwrElev = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwrElev))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwrElev) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwrElev,1), UBOUND(OutData%TwrElev,1) + OutData%TwrElev(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrDiam not allocated Int_Xferred = Int_Xferred + 1 @@ -2456,15 +2381,10 @@ SUBROUTINE AD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrDiam.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwrDiam)>0) OutData%TwrDiam = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwrDiam))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwrDiam) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwrDiam,1), UBOUND(OutData%TwrDiam,1) + OutData%TwrDiam(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE AD_UnPackInitOutput @@ -2601,6 +2521,21 @@ SUBROUTINE AD_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrSt ENDIF DstInputFileData%tau1_const = SrcInputFileData%tau1_const DstInputFileData%DBEMT_Mod = SrcInputFileData%DBEMT_Mod + DstInputFileData%BldNd_NumOuts = SrcInputFileData%BldNd_NumOuts +IF (ALLOCATED(SrcInputFileData%BldNd_OutList)) THEN + i1_l = LBOUND(SrcInputFileData%BldNd_OutList,1) + i1_u = UBOUND(SrcInputFileData%BldNd_OutList,1) + IF (.NOT. ALLOCATED(DstInputFileData%BldNd_OutList)) THEN + ALLOCATE(DstInputFileData%BldNd_OutList(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%BldNd_OutList.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInputFileData%BldNd_OutList = SrcInputFileData%BldNd_OutList +ENDIF + DstInputFileData%BldNd_BlOutNd_Str = SrcInputFileData%BldNd_BlOutNd_Str + DstInputFileData%BldNd_BladesOut = SrcInputFileData%BldNd_BladesOut END SUBROUTINE AD_CopyInputFile SUBROUTINE AD_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) @@ -2632,6 +2567,9 @@ SUBROUTINE AD_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) ENDIF IF (ALLOCATED(InputFileData%OutList)) THEN DEALLOCATE(InputFileData%OutList) +ENDIF +IF (ALLOCATED(InputFileData%BldNd_OutList)) THEN + DEALLOCATE(InputFileData%BldNd_OutList) ENDIF END SUBROUTINE AD_DestroyInputFile @@ -2761,6 +2699,14 @@ SUBROUTINE AD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg END IF Re_BufSz = Re_BufSz + 1 ! tau1_const Int_BufSz = Int_BufSz + 1 ! DBEMT_Mod + Int_BufSz = Int_BufSz + 1 ! BldNd_NumOuts + Int_BufSz = Int_BufSz + 1 ! BldNd_OutList allocated yes/no + IF ( ALLOCATED(InData%BldNd_OutList) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! BldNd_OutList upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%BldNd_OutList)*LEN(InData%BldNd_OutList) ! BldNd_OutList + END IF + Int_BufSz = Int_BufSz + 1*LEN(InData%BldNd_BlOutNd_Str) ! BldNd_BlOutNd_Str + Int_BufSz = Int_BufSz + 1 ! BldNd_BladesOut IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -2788,70 +2734,70 @@ SUBROUTINE AD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DTAero - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WakeMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%AFAeroMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TwrPotent - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TwrShadow , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TwrAero , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%FrozenWake , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%CavitCheck , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AirDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%KinVisc - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Patm - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Pvap - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%FluidDepth - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SpdSound - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%SkewMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SkewModFactor - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TipLoss , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%HubLoss , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TanInd , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%AIDrag , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TIDrag , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%IndToler - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MaxIter - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UAMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%FLookup , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%InCol_Alfa - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%InCol_Cl - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%InCol_Cd - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%InCol_Cm - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%InCol_Cpmin - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%AFTabMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumAFfiles - Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DTAero + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WakeMod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%AFAeroMod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TwrPotent + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TwrShadow, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TwrAero, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%FrozenWake, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%CavitCheck, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AirDens + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%KinVisc + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Patm + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Pvap + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FluidDepth + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SpdSound + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%SkewMod + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SkewModFactor + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TipLoss, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%HubLoss, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TanInd, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%AIDrag, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TIDrag, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%IndToler + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MaxIter + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%UAMod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%FLookup, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%InCol_Alfa + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%InCol_Cl + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%InCol_Cd + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%InCol_Cm + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%InCol_Cpmin + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%AFTabMod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumAFfiles + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%AFNames) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2862,15 +2808,15 @@ SUBROUTINE AD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFNames,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%AFNames,1), UBOUND(InData%AFNames,1) + DO i1 = LBOUND(InData%AFNames,1), UBOUND(InData%AFNames,1) DO I = 1, LEN(InData%AFNames) IntKiBuf(Int_Xferred) = ICHAR(InData%AFNames(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%UseBlCm , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%UseBlCm, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%BladeProps) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2912,8 +2858,8 @@ SUBROUTINE AD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg ENDIF END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumTwrNds - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumTwrNds + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%TwrElev) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2924,8 +2870,10 @@ SUBROUTINE AD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrElev,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwrElev)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwrElev))-1 ) = PACK(InData%TwrElev,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwrElev) + DO i1 = LBOUND(InData%TwrElev,1), UBOUND(InData%TwrElev,1) + ReKiBuf(Re_Xferred) = InData%TwrElev(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TwrDiam) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2937,8 +2885,10 @@ SUBROUTINE AD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrDiam,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwrDiam)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwrDiam))-1 ) = PACK(InData%TwrDiam,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwrDiam) + DO i1 = LBOUND(InData%TwrDiam,1), UBOUND(InData%TwrDiam,1) + ReKiBuf(Re_Xferred) = InData%TwrDiam(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TwrCd) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2950,21 +2900,27 @@ SUBROUTINE AD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrCd,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwrCd)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwrCd))-1 ) = PACK(InData%TwrCd,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwrCd) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%SumPrint , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NBlOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%BlOutNd))-1 ) = PACK(InData%BlOutNd,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%BlOutNd) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NTwOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%TwOutNd))-1 ) = PACK(InData%TwOutNd,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%TwOutNd) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%TwrCd,1), UBOUND(InData%TwrCd,1) + ReKiBuf(Re_Xferred) = InData%TwrCd(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IntKiBuf(Int_Xferred) = TRANSFER(InData%SumPrint, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NBlOuts + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%BlOutNd,1), UBOUND(InData%BlOutNd,1) + IntKiBuf(Int_Xferred) = InData%BlOutNd(i1) + Int_Xferred = Int_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%NTwOuts + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%TwOutNd,1), UBOUND(InData%TwOutNd,1) + IntKiBuf(Int_Xferred) = InData%TwOutNd(i1) + Int_Xferred = Int_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%OutList) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2975,17 +2931,42 @@ SUBROUTINE AD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutList,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) + DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) DO I = 1, LEN(InData%OutList) IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + ReKiBuf(Re_Xferred) = InData%tau1_const + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DBEMT_Mod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%BldNd_NumOuts + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%BldNd_OutList) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BldNd_OutList,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldNd_OutList,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%BldNd_OutList,1), UBOUND(InData%BldNd_OutList,1) + DO I = 1, LEN(InData%BldNd_OutList) + IntKiBuf(Int_Xferred) = ICHAR(InData%BldNd_OutList(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%tau1_const - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DBEMT_Mod - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%BldNd_BlOutNd_Str) + IntKiBuf(Int_Xferred) = ICHAR(InData%BldNd_BlOutNd_Str(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%BldNd_BladesOut + Int_Xferred = Int_Xferred + 1 END SUBROUTINE AD_PackInputFile SUBROUTINE AD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -3001,12 +2982,6 @@ SUBROUTINE AD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -3021,70 +2996,70 @@ SUBROUTINE AD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DTAero = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%WakeMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%AFAeroMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TwrPotent = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TwrShadow = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%TwrAero = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%FrozenWake = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%CavitCheck = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%AirDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%KinVisc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Patm = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Pvap = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%FluidDepth = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SpdSound = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SkewMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%SkewModFactor = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TipLoss = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%HubLoss = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%TanInd = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%AIDrag = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%TIDrag = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%IndToler = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MaxIter = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%UAMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%FLookup = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%InCol_Alfa = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%InCol_Cl = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%InCol_Cd = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%InCol_Cm = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%InCol_Cpmin = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%AFTabMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumAFfiles = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%DTAero = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%WakeMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%AFAeroMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TwrPotent = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TwrShadow = TRANSFER(IntKiBuf(Int_Xferred), OutData%TwrShadow) + Int_Xferred = Int_Xferred + 1 + OutData%TwrAero = TRANSFER(IntKiBuf(Int_Xferred), OutData%TwrAero) + Int_Xferred = Int_Xferred + 1 + OutData%FrozenWake = TRANSFER(IntKiBuf(Int_Xferred), OutData%FrozenWake) + Int_Xferred = Int_Xferred + 1 + OutData%CavitCheck = TRANSFER(IntKiBuf(Int_Xferred), OutData%CavitCheck) + Int_Xferred = Int_Xferred + 1 + OutData%AirDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%KinVisc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Patm = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Pvap = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%FluidDepth = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SpdSound = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SkewMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%SkewModFactor = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TipLoss = TRANSFER(IntKiBuf(Int_Xferred), OutData%TipLoss) + Int_Xferred = Int_Xferred + 1 + OutData%HubLoss = TRANSFER(IntKiBuf(Int_Xferred), OutData%HubLoss) + Int_Xferred = Int_Xferred + 1 + OutData%TanInd = TRANSFER(IntKiBuf(Int_Xferred), OutData%TanInd) + Int_Xferred = Int_Xferred + 1 + OutData%AIDrag = TRANSFER(IntKiBuf(Int_Xferred), OutData%AIDrag) + Int_Xferred = Int_Xferred + 1 + OutData%TIDrag = TRANSFER(IntKiBuf(Int_Xferred), OutData%TIDrag) + Int_Xferred = Int_Xferred + 1 + OutData%IndToler = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MaxIter = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%UAMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%FLookup = TRANSFER(IntKiBuf(Int_Xferred), OutData%FLookup) + Int_Xferred = Int_Xferred + 1 + OutData%InCol_Alfa = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%InCol_Cl = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%InCol_Cd = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%InCol_Cm = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%InCol_Cpmin = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%AFTabMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumAFfiles = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AFNames not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3098,22 +3073,15 @@ SUBROUTINE AD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFNames.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%AFNames,1), UBOUND(OutData%AFNames,1) + DO i1 = LBOUND(OutData%AFNames,1), UBOUND(OutData%AFNames,1) DO I = 1, LEN(OutData%AFNames) OutData%AFNames(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF - OutData%UseBlCm = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%UseBlCm = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseBlCm) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeProps not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3170,8 +3138,8 @@ SUBROUTINE AD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%NumTwrNds = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NumTwrNds = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrElev not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3185,15 +3153,10 @@ SUBROUTINE AD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrElev.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwrElev)>0) OutData%TwrElev = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwrElev))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwrElev) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwrElev,1), UBOUND(OutData%TwrElev,1) + OutData%TwrElev(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrDiam not allocated Int_Xferred = Int_Xferred + 1 @@ -3208,15 +3171,10 @@ SUBROUTINE AD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrDiam.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwrDiam)>0) OutData%TwrDiam = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwrDiam))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwrDiam) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwrDiam,1), UBOUND(OutData%TwrDiam,1) + OutData%TwrDiam(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrCd not allocated Int_Xferred = Int_Xferred + 1 @@ -3231,46 +3189,31 @@ SUBROUTINE AD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrCd.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwrCd)>0) OutData%TwrCd = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwrCd))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwrCd) - DEALLOCATE(mask1) - END IF - OutData%SumPrint = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NBlOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%TwrCd,1), UBOUND(OutData%TwrCd,1) + OutData%TwrCd(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%SumPrint = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumPrint) + Int_Xferred = Int_Xferred + 1 + OutData%NBlOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%BlOutNd,1) i1_u = UBOUND(OutData%BlOutNd,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%BlOutNd = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%BlOutNd))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%BlOutNd) - DEALLOCATE(mask1) - OutData%NTwOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%BlOutNd,1), UBOUND(OutData%BlOutNd,1) + OutData%BlOutNd(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + OutData%NTwOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%TwOutNd,1) i1_u = UBOUND(OutData%TwOutNd,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%TwOutNd = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%TwOutNd))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%TwOutNd) - DEALLOCATE(mask1) - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%TwOutNd,1), UBOUND(OutData%TwOutNd,1) + OutData%TwOutNd(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutList not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3284,24 +3227,45 @@ SUBROUTINE AD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) + DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) + DO I = 1, LEN(OutData%OutList) + OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + OutData%tau1_const = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%DBEMT_Mod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%BldNd_NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldNd_OutList not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BldNd_OutList)) DEALLOCATE(OutData%BldNd_OutList) + ALLOCATE(OutData%BldNd_OutList(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_OutList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) - DO I = 1, LEN(OutData%OutList) - OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%BldNd_OutList,1), UBOUND(OutData%BldNd_OutList,1) + DO I = 1, LEN(OutData%BldNd_OutList) + OutData%BldNd_OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF - OutData%tau1_const = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%DBEMT_Mod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%BldNd_BlOutNd_Str) + OutData%BldNd_BlOutNd_Str(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%BldNd_BladesOut = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE AD_UnPackInputFile SUBROUTINE AD_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) @@ -3458,12 +3422,6 @@ SUBROUTINE AD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD_UnPackContState' @@ -3673,12 +3631,6 @@ SUBROUTINE AD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD_UnPackDiscState' @@ -3888,12 +3840,6 @@ SUBROUTINE AD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD_UnPackConstrState' @@ -4103,12 +4049,6 @@ SUBROUTINE AD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD_UnPackOtherState' @@ -4807,8 +4747,14 @@ SUBROUTINE AD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DisturbedInflow,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DisturbedInflow)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%DisturbedInflow))-1 ) = PACK(InData%DisturbedInflow,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%DisturbedInflow) + DO i3 = LBOUND(InData%DisturbedInflow,3), UBOUND(InData%DisturbedInflow,3) + DO i2 = LBOUND(InData%DisturbedInflow,2), UBOUND(InData%DisturbedInflow,2) + DO i1 = LBOUND(InData%DisturbedInflow,1), UBOUND(InData%DisturbedInflow,1) + ReKiBuf(Re_Xferred) = InData%DisturbedInflow(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WithoutSweepPitchTwist) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4829,8 +4775,16 @@ SUBROUTINE AD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WithoutSweepPitchTwist,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WithoutSweepPitchTwist)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WithoutSweepPitchTwist))-1 ) = PACK(InData%WithoutSweepPitchTwist,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WithoutSweepPitchTwist) + DO i4 = LBOUND(InData%WithoutSweepPitchTwist,4), UBOUND(InData%WithoutSweepPitchTwist,4) + DO i3 = LBOUND(InData%WithoutSweepPitchTwist,3), UBOUND(InData%WithoutSweepPitchTwist,3) + DO i2 = LBOUND(InData%WithoutSweepPitchTwist,2), UBOUND(InData%WithoutSweepPitchTwist,2) + DO i1 = LBOUND(InData%WithoutSweepPitchTwist,1), UBOUND(InData%WithoutSweepPitchTwist,1) + ReKiBuf(Re_Xferred) = InData%WithoutSweepPitchTwist(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%AllOuts) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4842,8 +4796,10 @@ SUBROUTINE AD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AllOuts,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AllOuts)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AllOuts))-1 ) = PACK(InData%AllOuts,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AllOuts) + DO i1 = LBOUND(InData%AllOuts,1), UBOUND(InData%AllOuts,1) + ReKiBuf(Re_Xferred) = InData%AllOuts(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%W_Twr) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4855,8 +4811,10 @@ SUBROUTINE AD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%W_Twr,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%W_Twr)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%W_Twr))-1 ) = PACK(InData%W_Twr,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%W_Twr) + DO i1 = LBOUND(InData%W_Twr,1), UBOUND(InData%W_Twr,1) + ReKiBuf(Re_Xferred) = InData%W_Twr(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%X_Twr) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4868,8 +4826,10 @@ SUBROUTINE AD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%X_Twr,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%X_Twr)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%X_Twr))-1 ) = PACK(InData%X_Twr,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%X_Twr) + DO i1 = LBOUND(InData%X_Twr,1), UBOUND(InData%X_Twr,1) + ReKiBuf(Re_Xferred) = InData%X_Twr(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%Y_Twr) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4881,8 +4841,10 @@ SUBROUTINE AD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Y_Twr,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Y_Twr)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Y_Twr))-1 ) = PACK(InData%Y_Twr,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Y_Twr) + DO i1 = LBOUND(InData%Y_Twr,1), UBOUND(InData%Y_Twr,1) + ReKiBuf(Re_Xferred) = InData%Y_Twr(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%Curve) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4897,8 +4859,12 @@ SUBROUTINE AD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Curve,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Curve)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Curve))-1 ) = PACK(InData%Curve,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Curve) + DO i2 = LBOUND(InData%Curve,2), UBOUND(InData%Curve,2) + DO i1 = LBOUND(InData%Curve,1), UBOUND(InData%Curve,1) + ReKiBuf(Re_Xferred) = InData%Curve(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%TwrClrnc) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4913,8 +4879,12 @@ SUBROUTINE AD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrClrnc,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwrClrnc)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwrClrnc))-1 ) = PACK(InData%TwrClrnc,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwrClrnc) + DO i2 = LBOUND(InData%TwrClrnc,2), UBOUND(InData%TwrClrnc,2) + DO i1 = LBOUND(InData%TwrClrnc,1), UBOUND(InData%TwrClrnc,1) + ReKiBuf(Re_Xferred) = InData%TwrClrnc(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%X) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4929,8 +4899,12 @@ SUBROUTINE AD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%X,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%X)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%X))-1 ) = PACK(InData%X,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%X) + DO i2 = LBOUND(InData%X,2), UBOUND(InData%X,2) + DO i1 = LBOUND(InData%X,1), UBOUND(InData%X,1) + ReKiBuf(Re_Xferred) = InData%X(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Y) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4945,8 +4919,12 @@ SUBROUTINE AD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Y,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Y)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Y))-1 ) = PACK(InData%Y,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Y) + DO i2 = LBOUND(InData%Y,2), UBOUND(InData%Y,2) + DO i1 = LBOUND(InData%Y,1), UBOUND(InData%Y,1) + ReKiBuf(Re_Xferred) = InData%Y(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%M) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4961,15 +4939,23 @@ SUBROUTINE AD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%M)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%M))-1 ) = PACK(InData%M,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%M) + DO i2 = LBOUND(InData%M,2), UBOUND(InData%M,2) + DO i1 = LBOUND(InData%M,1), UBOUND(InData%M,1) + ReKiBuf(Re_Xferred) = InData%M(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%V_DiskAvg))-1 ) = PACK(InData%V_DiskAvg,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%V_DiskAvg) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%hub_theta_x_root))-1 ) = PACK(InData%hub_theta_x_root,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%hub_theta_x_root) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%V_dot_x - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%V_DiskAvg,1), UBOUND(InData%V_DiskAvg,1) + ReKiBuf(Re_Xferred) = InData%V_DiskAvg(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%hub_theta_x_root,1), UBOUND(InData%hub_theta_x_root,1) + ReKiBuf(Re_Xferred) = InData%hub_theta_x_root(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%V_dot_x + Re_Xferred = Re_Xferred + 1 CALL MeshPack( InData%HubLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! HubLoad CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -5052,8 +5038,12 @@ SUBROUTINE AD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SigmaCavitCrit,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%SigmaCavitCrit)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SigmaCavitCrit))-1 ) = PACK(InData%SigmaCavitCrit,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SigmaCavitCrit) + DO i2 = LBOUND(InData%SigmaCavitCrit,2), UBOUND(InData%SigmaCavitCrit,2) + DO i1 = LBOUND(InData%SigmaCavitCrit,1), UBOUND(InData%SigmaCavitCrit,1) + ReKiBuf(Re_Xferred) = InData%SigmaCavitCrit(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%SigmaCavit) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5068,8 +5058,12 @@ SUBROUTINE AD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SigmaCavit,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%SigmaCavit)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SigmaCavit))-1 ) = PACK(InData%SigmaCavit,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SigmaCavit) + DO i2 = LBOUND(InData%SigmaCavit,2), UBOUND(InData%SigmaCavit,2) + DO i1 = LBOUND(InData%SigmaCavit,1), UBOUND(InData%SigmaCavit,1) + ReKiBuf(Re_Xferred) = InData%SigmaCavit(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%CavitWarnSet) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5084,8 +5078,12 @@ SUBROUTINE AD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CavitWarnSet,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CavitWarnSet)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%CavitWarnSet)-1 ) = TRANSFER(PACK( InData%CavitWarnSet ,.TRUE.), IntKiBuf(1), SIZE(InData%CavitWarnSet)) - Int_Xferred = Int_Xferred + SIZE(InData%CavitWarnSet) + DO i2 = LBOUND(InData%CavitWarnSet,2), UBOUND(InData%CavitWarnSet,2) + DO i1 = LBOUND(InData%CavitWarnSet,1), UBOUND(InData%CavitWarnSet,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%CavitWarnSet(i1,i2), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF END SUBROUTINE AD_PackMisc @@ -5102,12 +5100,6 @@ SUBROUTINE AD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (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 @@ -5268,15 +5260,14 @@ SUBROUTINE AD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DisturbedInflow.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%DisturbedInflow)>0) OutData%DisturbedInflow = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%DisturbedInflow))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%DisturbedInflow) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%DisturbedInflow,3), UBOUND(OutData%DisturbedInflow,3) + DO i2 = LBOUND(OutData%DisturbedInflow,2), UBOUND(OutData%DisturbedInflow,2) + DO i1 = LBOUND(OutData%DisturbedInflow,1), UBOUND(OutData%DisturbedInflow,1) + OutData%DisturbedInflow(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WithoutSweepPitchTwist not allocated Int_Xferred = Int_Xferred + 1 @@ -5300,15 +5291,16 @@ SUBROUTINE AD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WithoutSweepPitchTwist.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%WithoutSweepPitchTwist)>0) OutData%WithoutSweepPitchTwist = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WithoutSweepPitchTwist))-1 ), mask4, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WithoutSweepPitchTwist) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%WithoutSweepPitchTwist,4), UBOUND(OutData%WithoutSweepPitchTwist,4) + DO i3 = LBOUND(OutData%WithoutSweepPitchTwist,3), UBOUND(OutData%WithoutSweepPitchTwist,3) + DO i2 = LBOUND(OutData%WithoutSweepPitchTwist,2), UBOUND(OutData%WithoutSweepPitchTwist,2) + DO i1 = LBOUND(OutData%WithoutSweepPitchTwist,1), UBOUND(OutData%WithoutSweepPitchTwist,1) + OutData%WithoutSweepPitchTwist(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AllOuts not allocated Int_Xferred = Int_Xferred + 1 @@ -5323,15 +5315,10 @@ SUBROUTINE AD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOuts.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%AllOuts)>0) OutData%AllOuts = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AllOuts))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AllOuts) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AllOuts,1), UBOUND(OutData%AllOuts,1) + OutData%AllOuts(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! W_Twr not allocated Int_Xferred = Int_Xferred + 1 @@ -5346,15 +5333,10 @@ SUBROUTINE AD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%W_Twr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%W_Twr)>0) OutData%W_Twr = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%W_Twr))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%W_Twr) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%W_Twr,1), UBOUND(OutData%W_Twr,1) + OutData%W_Twr(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! X_Twr not allocated Int_Xferred = Int_Xferred + 1 @@ -5369,15 +5351,10 @@ SUBROUTINE AD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%X_Twr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%X_Twr)>0) OutData%X_Twr = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%X_Twr))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%X_Twr) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%X_Twr,1), UBOUND(OutData%X_Twr,1) + OutData%X_Twr(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Y_Twr not allocated Int_Xferred = Int_Xferred + 1 @@ -5392,15 +5369,10 @@ SUBROUTINE AD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Y_Twr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Y_Twr)>0) OutData%Y_Twr = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Y_Twr))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Y_Twr) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Y_Twr,1), UBOUND(OutData%Y_Twr,1) + OutData%Y_Twr(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Curve not allocated Int_Xferred = Int_Xferred + 1 @@ -5418,15 +5390,12 @@ SUBROUTINE AD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Curve.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Curve)>0) OutData%Curve = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Curve))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Curve) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Curve,2), UBOUND(OutData%Curve,2) + DO i1 = LBOUND(OutData%Curve,1), UBOUND(OutData%Curve,1) + OutData%Curve(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrClrnc not allocated Int_Xferred = Int_Xferred + 1 @@ -5444,15 +5413,12 @@ SUBROUTINE AD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrClrnc.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%TwrClrnc)>0) OutData%TwrClrnc = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwrClrnc))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwrClrnc) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%TwrClrnc,2), UBOUND(OutData%TwrClrnc,2) + DO i1 = LBOUND(OutData%TwrClrnc,1), UBOUND(OutData%TwrClrnc,1) + OutData%TwrClrnc(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! X not allocated Int_Xferred = Int_Xferred + 1 @@ -5470,15 +5436,12 @@ SUBROUTINE AD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%X.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%X)>0) OutData%X = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%X))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%X) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%X,2), UBOUND(OutData%X,2) + DO i1 = LBOUND(OutData%X,1), UBOUND(OutData%X,1) + OutData%X(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Y not allocated Int_Xferred = Int_Xferred + 1 @@ -5496,15 +5459,12 @@ SUBROUTINE AD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Y.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Y)>0) OutData%Y = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Y))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Y) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Y,2), UBOUND(OutData%Y,2) + DO i1 = LBOUND(OutData%Y,1), UBOUND(OutData%Y,1) + OutData%Y(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! M not allocated Int_Xferred = Int_Xferred + 1 @@ -5522,40 +5482,27 @@ SUBROUTINE AD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%M.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%M)>0) OutData%M = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%M))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%M) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%M,2), UBOUND(OutData%M,2) + DO i1 = LBOUND(OutData%M,1), UBOUND(OutData%M,1) + OutData%M(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF i1_l = LBOUND(OutData%V_DiskAvg,1) i1_u = UBOUND(OutData%V_DiskAvg,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%V_DiskAvg = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%V_DiskAvg))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%V_DiskAvg) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%V_DiskAvg,1), UBOUND(OutData%V_DiskAvg,1) + OutData%V_DiskAvg(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%hub_theta_x_root,1) i1_u = UBOUND(OutData%hub_theta_x_root,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%hub_theta_x_root = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%hub_theta_x_root))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%hub_theta_x_root) - DEALLOCATE(mask1) - OutData%V_dot_x = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%hub_theta_x_root,1), UBOUND(OutData%hub_theta_x_root,1) + OutData%hub_theta_x_root(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%V_dot_x = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -5668,15 +5615,12 @@ SUBROUTINE AD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SigmaCavitCrit.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%SigmaCavitCrit)>0) OutData%SigmaCavitCrit = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SigmaCavitCrit))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SigmaCavitCrit) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%SigmaCavitCrit,2), UBOUND(OutData%SigmaCavitCrit,2) + DO i1 = LBOUND(OutData%SigmaCavitCrit,1), UBOUND(OutData%SigmaCavitCrit,1) + OutData%SigmaCavitCrit(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SigmaCavit not allocated Int_Xferred = Int_Xferred + 1 @@ -5694,15 +5638,12 @@ SUBROUTINE AD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SigmaCavit.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%SigmaCavit)>0) OutData%SigmaCavit = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SigmaCavit))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SigmaCavit) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%SigmaCavit,2), UBOUND(OutData%SigmaCavit,2) + DO i1 = LBOUND(OutData%SigmaCavit,1), UBOUND(OutData%SigmaCavit,1) + OutData%SigmaCavit(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CavitWarnSet not allocated Int_Xferred = Int_Xferred + 1 @@ -5720,15 +5661,12 @@ SUBROUTINE AD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CavitWarnSet.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%CavitWarnSet)>0) OutData%CavitWarnSet = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%CavitWarnSet))-1 ), OutData%CavitWarnSet), mask2,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%CavitWarnSet) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%CavitWarnSet,2), UBOUND(OutData%CavitWarnSet,2) + DO i1 = LBOUND(OutData%CavitWarnSet,1), UBOUND(OutData%CavitWarnSet,1) + OutData%CavitWarnSet(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%CavitWarnSet(i1,i2)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF END SUBROUTINE AD_UnPackMisc @@ -5830,6 +5768,37 @@ SUBROUTINE AD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) DstParamData%BlOutNd = SrcParamData%BlOutNd DstParamData%NTwOuts = SrcParamData%NTwOuts DstParamData%TwOutNd = SrcParamData%TwOutNd + DstParamData%BldNd_NumOuts = SrcParamData%BldNd_NumOuts + DstParamData%BldNd_TotNumOuts = SrcParamData%BldNd_TotNumOuts +IF (ALLOCATED(SrcParamData%BldNd_OutParam)) THEN + i1_l = LBOUND(SrcParamData%BldNd_OutParam,1) + i1_u = UBOUND(SrcParamData%BldNd_OutParam,1) + IF (.NOT. ALLOCATED(DstParamData%BldNd_OutParam)) THEN + ALLOCATE(DstParamData%BldNd_OutParam(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldNd_OutParam.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcParamData%BldNd_OutParam,1), UBOUND(SrcParamData%BldNd_OutParam,1) + CALL NWTC_Library_Copyoutparmtype( SrcParamData%BldNd_OutParam(i1), DstParamData%BldNd_OutParam(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcParamData%BldNd_BlOutNd)) THEN + i1_l = LBOUND(SrcParamData%BldNd_BlOutNd,1) + i1_u = UBOUND(SrcParamData%BldNd_BlOutNd,1) + IF (.NOT. ALLOCATED(DstParamData%BldNd_BlOutNd)) THEN + ALLOCATE(DstParamData%BldNd_BlOutNd(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldNd_BlOutNd.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%BldNd_BlOutNd = SrcParamData%BldNd_BlOutNd +ENDIF + DstParamData%BldNd_BladesOut = SrcParamData%BldNd_BladesOut IF (ALLOCATED(SrcParamData%Jac_u_indx)) THEN i1_l = LBOUND(SrcParamData%Jac_u_indx,1) i1_u = UBOUND(SrcParamData%Jac_u_indx,1) @@ -5887,6 +5856,15 @@ SUBROUTINE AD_DestroyParam( ParamData, ErrStat, ErrMsg ) ENDDO DEALLOCATE(ParamData%OutParam) ENDIF +IF (ALLOCATED(ParamData%BldNd_OutParam)) THEN +DO i1 = LBOUND(ParamData%BldNd_OutParam,1), UBOUND(ParamData%BldNd_OutParam,1) + CALL NWTC_Library_Destroyoutparmtype( ParamData%BldNd_OutParam(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(ParamData%BldNd_OutParam) +ENDIF +IF (ALLOCATED(ParamData%BldNd_BlOutNd)) THEN + DEALLOCATE(ParamData%BldNd_BlOutNd) +ENDIF IF (ALLOCATED(ParamData%Jac_u_indx)) THEN DEALLOCATE(ParamData%Jac_u_indx) ENDIF @@ -6027,6 +6005,37 @@ SUBROUTINE AD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Int_BufSz = Int_BufSz + SIZE(InData%BlOutNd) ! BlOutNd Int_BufSz = Int_BufSz + 1 ! NTwOuts Int_BufSz = Int_BufSz + SIZE(InData%TwOutNd) ! TwOutNd + Int_BufSz = Int_BufSz + 1 ! BldNd_NumOuts + Int_BufSz = Int_BufSz + 1 ! BldNd_TotNumOuts + Int_BufSz = Int_BufSz + 1 ! BldNd_OutParam allocated yes/no + IF ( ALLOCATED(InData%BldNd_OutParam) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! BldNd_OutParam upper/lower bounds for each dimension + DO i1 = LBOUND(InData%BldNd_OutParam,1), UBOUND(InData%BldNd_OutParam,1) + Int_BufSz = Int_BufSz + 3 ! BldNd_OutParam: size of buffers for each call to pack subtype + CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%BldNd_OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BldNd_OutParam + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! BldNd_OutParam + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! BldNd_OutParam + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! BldNd_OutParam + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! BldNd_BlOutNd allocated yes/no + IF ( ALLOCATED(InData%BldNd_BlOutNd) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! BldNd_BlOutNd upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%BldNd_BlOutNd) ! BldNd_BlOutNd + END IF + Int_BufSz = Int_BufSz + 1 ! BldNd_BladesOut Int_BufSz = Int_BufSz + 1 ! Jac_u_indx allocated yes/no IF ( ALLOCATED(InData%Jac_u_indx) ) THEN Int_BufSz = Int_BufSz + 2*2 ! Jac_u_indx upper/lower bounds for each dimension @@ -6065,26 +6074,26 @@ SUBROUTINE AD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WakeMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TwrPotent - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TwrShadow , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TwrAero , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%FrozenWake , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%CavitCheck , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumBlades - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumBlNds - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumTwrNds - Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WakeMod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TwrPotent + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TwrShadow, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TwrAero, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%FrozenWake, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%CavitCheck, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumBlades + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumBlNds + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumTwrNds + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%TwrDiam) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -6095,8 +6104,10 @@ SUBROUTINE AD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrDiam,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwrDiam)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwrDiam))-1 ) = PACK(InData%TwrDiam,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwrDiam) + DO i1 = LBOUND(InData%TwrDiam,1), UBOUND(InData%TwrDiam,1) + ReKiBuf(Re_Xferred) = InData%TwrDiam(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TwrCd) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6108,23 +6119,25 @@ SUBROUTINE AD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrCd,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwrCd)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwrCd))-1 ) = PACK(InData%TwrCd,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwrCd) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AirDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%KinVisc - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SpdSound - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Patm - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Pvap - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%FluidDepth - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%TwrCd,1), UBOUND(InData%TwrCd,1) + ReKiBuf(Re_Xferred) = InData%TwrCd(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%AirDens + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%KinVisc + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SpdSound + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Gravity + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Patm + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Pvap + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FluidDepth + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%AFI) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -6194,12 +6207,12 @@ SUBROUTINE AD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( .NOT. ALLOCATED(InData%OutParam) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -6241,14 +6254,80 @@ SUBROUTINE AD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si ENDIF END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NBlOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%BlOutNd))-1 ) = PACK(InData%BlOutNd,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%BlOutNd) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NTwOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%TwOutNd))-1 ) = PACK(InData%TwOutNd,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%TwOutNd) + IntKiBuf(Int_Xferred) = InData%NBlOuts + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%BlOutNd,1), UBOUND(InData%BlOutNd,1) + IntKiBuf(Int_Xferred) = InData%BlOutNd(i1) + Int_Xferred = Int_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%NTwOuts + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%TwOutNd,1), UBOUND(InData%TwOutNd,1) + IntKiBuf(Int_Xferred) = InData%TwOutNd(i1) + Int_Xferred = Int_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%BldNd_NumOuts + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%BldNd_TotNumOuts + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%BldNd_OutParam) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BldNd_OutParam,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldNd_OutParam,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%BldNd_OutParam,1), UBOUND(InData%BldNd_OutParam,1) + CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%BldNd_OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! BldNd_OutParam + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%BldNd_BlOutNd) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BldNd_BlOutNd,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldNd_BlOutNd,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%BldNd_BlOutNd,1), UBOUND(InData%BldNd_BlOutNd,1) + IntKiBuf(Int_Xferred) = InData%BldNd_BlOutNd(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IntKiBuf(Int_Xferred) = InData%BldNd_BladesOut + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%Jac_u_indx) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -6262,8 +6341,12 @@ SUBROUTINE AD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Jac_u_indx)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%Jac_u_indx))-1 ) = PACK(InData%Jac_u_indx,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%Jac_u_indx) + DO i2 = LBOUND(InData%Jac_u_indx,2), UBOUND(InData%Jac_u_indx,2) + DO i1 = LBOUND(InData%Jac_u_indx,1), UBOUND(InData%Jac_u_indx,1) + IntKiBuf(Int_Xferred) = InData%Jac_u_indx(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%du) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6275,11 +6358,13 @@ SUBROUTINE AD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%du,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%du)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%du))-1 ) = PACK(InData%du,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%du) + DO i1 = LBOUND(InData%du,1), UBOUND(InData%du,1) + ReKiBuf(Re_Xferred) = InData%du(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Jac_ny - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Jac_ny + Int_Xferred = Int_Xferred + 1 END SUBROUTINE AD_PackParam SUBROUTINE AD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -6295,12 +6380,6 @@ SUBROUTINE AD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -6316,26 +6395,26 @@ SUBROUTINE AD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%WakeMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TwrPotent = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TwrShadow = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%TwrAero = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%FrozenWake = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%CavitCheck = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NumBlades = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumBlNds = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumTwrNds = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%WakeMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TwrPotent = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TwrShadow = TRANSFER(IntKiBuf(Int_Xferred), OutData%TwrShadow) + Int_Xferred = Int_Xferred + 1 + OutData%TwrAero = TRANSFER(IntKiBuf(Int_Xferred), OutData%TwrAero) + Int_Xferred = Int_Xferred + 1 + OutData%FrozenWake = TRANSFER(IntKiBuf(Int_Xferred), OutData%FrozenWake) + Int_Xferred = Int_Xferred + 1 + OutData%CavitCheck = TRANSFER(IntKiBuf(Int_Xferred), OutData%CavitCheck) + Int_Xferred = Int_Xferred + 1 + OutData%NumBlades = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumBlNds = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumTwrNds = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrDiam not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -6349,15 +6428,10 @@ SUBROUTINE AD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrDiam.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwrDiam)>0) OutData%TwrDiam = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwrDiam))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwrDiam) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwrDiam,1), UBOUND(OutData%TwrDiam,1) + OutData%TwrDiam(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrCd not allocated Int_Xferred = Int_Xferred + 1 @@ -6372,30 +6446,25 @@ SUBROUTINE AD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrCd.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwrCd)>0) OutData%TwrCd = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwrCd))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwrCd) - DEALLOCATE(mask1) - END IF - OutData%AirDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%KinVisc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SpdSound = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Gravity = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Patm = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Pvap = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%FluidDepth = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%TwrCd,1), UBOUND(OutData%TwrCd,1) + OutData%TwrCd(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%AirDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%KinVisc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SpdSound = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Gravity = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Patm = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Pvap = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%FluidDepth = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AFI not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -6492,12 +6561,12 @@ SUBROUTINE AD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParam not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -6554,32 +6623,102 @@ SUBROUTINE AD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%NBlOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NBlOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%BlOutNd,1) i1_u = UBOUND(OutData%BlOutNd,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) + DO i1 = LBOUND(OutData%BlOutNd,1), UBOUND(OutData%BlOutNd,1) + OutData%BlOutNd(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + OutData%NTwOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + i1_l = LBOUND(OutData%TwOutNd,1) + i1_u = UBOUND(OutData%TwOutNd,1) + DO i1 = LBOUND(OutData%TwOutNd,1), UBOUND(OutData%TwOutNd,1) + OutData%TwOutNd(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + OutData%BldNd_NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%BldNd_TotNumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldNd_OutParam not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BldNd_OutParam)) DEALLOCATE(OutData%BldNd_OutParam) + ALLOCATE(OutData%BldNd_OutParam(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_OutParam.', ErrStat, ErrMsg,RoutineName) RETURN END IF - mask1 = .TRUE. - OutData%BlOutNd = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%BlOutNd))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%BlOutNd) - DEALLOCATE(mask1) - OutData%NTwOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%TwOutNd,1) - i1_u = UBOUND(OutData%TwOutNd,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) + DO i1 = LBOUND(OutData%BldNd_OutParam,1), UBOUND(OutData%BldNd_OutParam,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackoutparmtype( Re_Buf, Db_Buf, Int_Buf, OutData%BldNd_OutParam(i1), ErrStat2, ErrMsg2 ) ! BldNd_OutParam + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldNd_BlOutNd not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BldNd_BlOutNd)) DEALLOCATE(OutData%BldNd_BlOutNd) + ALLOCATE(OutData%BldNd_BlOutNd(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_BlOutNd.', ErrStat, ErrMsg,RoutineName) RETURN END IF - mask1 = .TRUE. - OutData%TwOutNd = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%TwOutNd))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%TwOutNd) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BldNd_BlOutNd,1), UBOUND(OutData%BldNd_BlOutNd,1) + OutData%BldNd_BlOutNd(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + OutData%BldNd_BladesOut = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_u_indx not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -6596,15 +6735,12 @@ SUBROUTINE AD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Jac_u_indx)>0) OutData%Jac_u_indx = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%Jac_u_indx))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%Jac_u_indx) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Jac_u_indx,2), UBOUND(OutData%Jac_u_indx,2) + DO i1 = LBOUND(OutData%Jac_u_indx,1), UBOUND(OutData%Jac_u_indx,1) + OutData%Jac_u_indx(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! du not allocated Int_Xferred = Int_Xferred + 1 @@ -6619,18 +6755,13 @@ SUBROUTINE AD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%du.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%du)>0) OutData%du = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%du))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%du) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%du,1), UBOUND(OutData%du,1) + OutData%du(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%Jac_ny = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%Jac_ny = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE AD_UnPackParam SUBROUTINE AD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -7080,8 +7211,14 @@ SUBROUTINE AD_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InflowOnBlade,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%InflowOnBlade)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%InflowOnBlade))-1 ) = PACK(InData%InflowOnBlade,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%InflowOnBlade) + DO i3 = LBOUND(InData%InflowOnBlade,3), UBOUND(InData%InflowOnBlade,3) + DO i2 = LBOUND(InData%InflowOnBlade,2), UBOUND(InData%InflowOnBlade,2) + DO i1 = LBOUND(InData%InflowOnBlade,1), UBOUND(InData%InflowOnBlade,1) + ReKiBuf(Re_Xferred) = InData%InflowOnBlade(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%InflowOnTower) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7096,8 +7233,12 @@ SUBROUTINE AD_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InflowOnTower,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%InflowOnTower)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%InflowOnTower))-1 ) = PACK(InData%InflowOnTower,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%InflowOnTower) + DO i2 = LBOUND(InData%InflowOnTower,2), UBOUND(InData%InflowOnTower,2) + DO i1 = LBOUND(InData%InflowOnTower,1), UBOUND(InData%InflowOnTower,1) + ReKiBuf(Re_Xferred) = InData%InflowOnTower(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%UserProp) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7112,8 +7253,12 @@ SUBROUTINE AD_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UserProp,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%UserProp)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%UserProp))-1 ) = PACK(InData%UserProp,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%UserProp) + DO i2 = LBOUND(InData%UserProp,2), UBOUND(InData%UserProp,2) + DO i1 = LBOUND(InData%UserProp,1), UBOUND(InData%UserProp,1) + ReKiBuf(Re_Xferred) = InData%UserProp(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE AD_PackInput @@ -7130,12 +7275,6 @@ SUBROUTINE AD_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (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 @@ -7363,15 +7502,14 @@ SUBROUTINE AD_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InflowOnBlade.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%InflowOnBlade)>0) OutData%InflowOnBlade = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%InflowOnBlade))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%InflowOnBlade) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%InflowOnBlade,3), UBOUND(OutData%InflowOnBlade,3) + DO i2 = LBOUND(OutData%InflowOnBlade,2), UBOUND(OutData%InflowOnBlade,2) + DO i1 = LBOUND(OutData%InflowOnBlade,1), UBOUND(OutData%InflowOnBlade,1) + OutData%InflowOnBlade(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InflowOnTower not allocated Int_Xferred = Int_Xferred + 1 @@ -7389,15 +7527,12 @@ SUBROUTINE AD_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InflowOnTower.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%InflowOnTower)>0) OutData%InflowOnTower = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%InflowOnTower))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%InflowOnTower) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%InflowOnTower,2), UBOUND(OutData%InflowOnTower,2) + DO i1 = LBOUND(OutData%InflowOnTower,1), UBOUND(OutData%InflowOnTower,1) + OutData%InflowOnTower(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UserProp not allocated Int_Xferred = Int_Xferred + 1 @@ -7415,15 +7550,12 @@ SUBROUTINE AD_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UserProp.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%UserProp)>0) OutData%UserProp = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%UserProp))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%UserProp) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%UserProp,2), UBOUND(OutData%UserProp,2) + DO i1 = LBOUND(OutData%UserProp,1), UBOUND(OutData%UserProp,1) + OutData%UserProp(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE AD_UnPackInput @@ -7683,8 +7815,10 @@ SUBROUTINE AD_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WriteOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WriteOutput))-1 ) = PACK(InData%WriteOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WriteOutput) + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE AD_PackOutput @@ -7701,12 +7835,6 @@ SUBROUTINE AD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -7830,15 +7958,10 @@ SUBROUTINE AD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WriteOutput)>0) OutData%WriteOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WriteOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WriteOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE AD_UnPackOutput @@ -7917,17 +8040,16 @@ SUBROUTINE AD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'AD_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: b3 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: c3 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + INTEGER :: i3 ! dim3 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -7940,47 +8062,49 @@ SUBROUTINE AD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(u1%TowerMotion, u2%TowerMotion, tin, u_out%TowerMotion, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL MeshExtrapInterp1(u1%HubMotion, u2%HubMotion, tin, u_out%HubMotion, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(u_out%BladeRootMotion) .AND. ALLOCATED(u1%BladeRootMotion)) THEN - DO i01 = LBOUND(u_out%BladeRootMotion,1),UBOUND(u_out%BladeRootMotion,1) - CALL MeshExtrapInterp1(u1%BladeRootMotion(i01), u2%BladeRootMotion(i01), tin, u_out%BladeRootMotion(i01), tin_out, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(u_out%BladeRootMotion,1),UBOUND(u_out%BladeRootMotion,1) + CALL MeshExtrapInterp1(u1%BladeRootMotion(i1), u2%BladeRootMotion(i1), tin, u_out%BladeRootMotion(i1), tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) ENDDO END IF ! check if allocated IF (ALLOCATED(u_out%BladeMotion) .AND. ALLOCATED(u1%BladeMotion)) THEN - DO i01 = LBOUND(u_out%BladeMotion,1),UBOUND(u_out%BladeMotion,1) - CALL MeshExtrapInterp1(u1%BladeMotion(i01), u2%BladeMotion(i01), tin, u_out%BladeMotion(i01), tin_out, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(u_out%BladeMotion,1),UBOUND(u_out%BladeMotion,1) + CALL MeshExtrapInterp1(u1%BladeMotion(i1), u2%BladeMotion(i1), tin, u_out%BladeMotion(i1), tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) ENDDO END IF ! check if allocated IF (ALLOCATED(u_out%InflowOnBlade) .AND. ALLOCATED(u1%InflowOnBlade)) THEN - ALLOCATE(b3(SIZE(u_out%InflowOnBlade,1),SIZE(u_out%InflowOnBlade,2), & - SIZE(u_out%InflowOnBlade,3) )) - ALLOCATE(c3(SIZE(u_out%InflowOnBlade,1),SIZE(u_out%InflowOnBlade,2), & - SIZE(u_out%InflowOnBlade,3) )) - b3 = -(u1%InflowOnBlade - u2%InflowOnBlade)/t(2) - u_out%InflowOnBlade = u1%InflowOnBlade + b3 * t_out - DEALLOCATE(b3) - DEALLOCATE(c3) + DO i3 = LBOUND(u_out%InflowOnBlade,3),UBOUND(u_out%InflowOnBlade,3) + DO i2 = LBOUND(u_out%InflowOnBlade,2),UBOUND(u_out%InflowOnBlade,2) + DO i1 = LBOUND(u_out%InflowOnBlade,1),UBOUND(u_out%InflowOnBlade,1) + b = -(u1%InflowOnBlade(i1,i2,i3) - u2%InflowOnBlade(i1,i2,i3)) + u_out%InflowOnBlade(i1,i2,i3) = u1%InflowOnBlade(i1,i2,i3) + b * ScaleFactor + END DO + END DO + END DO END IF ! check if allocated IF (ALLOCATED(u_out%InflowOnTower) .AND. ALLOCATED(u1%InflowOnTower)) THEN - ALLOCATE(b2(SIZE(u_out%InflowOnTower,1),SIZE(u_out%InflowOnTower,2) )) - ALLOCATE(c2(SIZE(u_out%InflowOnTower,1),SIZE(u_out%InflowOnTower,2) )) - b2 = -(u1%InflowOnTower - u2%InflowOnTower)/t(2) - u_out%InflowOnTower = u1%InflowOnTower + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%InflowOnTower,2),UBOUND(u_out%InflowOnTower,2) + DO i1 = LBOUND(u_out%InflowOnTower,1),UBOUND(u_out%InflowOnTower,1) + b = -(u1%InflowOnTower(i1,i2) - u2%InflowOnTower(i1,i2)) + u_out%InflowOnTower(i1,i2) = u1%InflowOnTower(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated IF (ALLOCATED(u_out%UserProp) .AND. ALLOCATED(u1%UserProp)) THEN - ALLOCATE(b2(SIZE(u_out%UserProp,1),SIZE(u_out%UserProp,2) )) - ALLOCATE(c2(SIZE(u_out%UserProp,1),SIZE(u_out%UserProp,2) )) - b2 = -(u1%UserProp - u2%UserProp)/t(2) - u_out%UserProp = u1%UserProp + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%UserProp,2),UBOUND(u_out%UserProp,2) + DO i1 = LBOUND(u_out%UserProp,1),UBOUND(u_out%UserProp,1) + b = -(u1%UserProp(i1,i2) - u2%UserProp(i1,i2)) + u_out%UserProp(i1,i2) = u1%UserProp(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated END SUBROUTINE AD_Input_ExtrapInterp1 @@ -8011,18 +8135,18 @@ SUBROUTINE AD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: b3 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: c3 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'AD_Input_ExtrapInterp2' INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + INTEGER :: i3 ! dim3 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -8041,50 +8165,52 @@ SUBROUTINE AD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(u1%TowerMotion, u2%TowerMotion, u3%TowerMotion, tin, u_out%TowerMotion, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL MeshExtrapInterp2(u1%HubMotion, u2%HubMotion, u3%HubMotion, tin, u_out%HubMotion, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(u_out%BladeRootMotion) .AND. ALLOCATED(u1%BladeRootMotion)) THEN - DO i01 = LBOUND(u_out%BladeRootMotion,1),UBOUND(u_out%BladeRootMotion,1) - CALL MeshExtrapInterp2(u1%BladeRootMotion(i01), u2%BladeRootMotion(i01), u3%BladeRootMotion(i01), tin, u_out%BladeRootMotion(i01), tin_out, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(u_out%BladeRootMotion,1),UBOUND(u_out%BladeRootMotion,1) + CALL MeshExtrapInterp2(u1%BladeRootMotion(i1), u2%BladeRootMotion(i1), u3%BladeRootMotion(i1), tin, u_out%BladeRootMotion(i1), tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) ENDDO END IF ! check if allocated IF (ALLOCATED(u_out%BladeMotion) .AND. ALLOCATED(u1%BladeMotion)) THEN - DO i01 = LBOUND(u_out%BladeMotion,1),UBOUND(u_out%BladeMotion,1) - CALL MeshExtrapInterp2(u1%BladeMotion(i01), u2%BladeMotion(i01), u3%BladeMotion(i01), tin, u_out%BladeMotion(i01), tin_out, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(u_out%BladeMotion,1),UBOUND(u_out%BladeMotion,1) + CALL MeshExtrapInterp2(u1%BladeMotion(i1), u2%BladeMotion(i1), u3%BladeMotion(i1), tin, u_out%BladeMotion(i1), tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) ENDDO END IF ! check if allocated IF (ALLOCATED(u_out%InflowOnBlade) .AND. ALLOCATED(u1%InflowOnBlade)) THEN - ALLOCATE(b3(SIZE(u_out%InflowOnBlade,1),SIZE(u_out%InflowOnBlade,2), & - SIZE(u_out%InflowOnBlade,3) )) - ALLOCATE(c3(SIZE(u_out%InflowOnBlade,1),SIZE(u_out%InflowOnBlade,2), & - SIZE(u_out%InflowOnBlade,3) )) - b3 = (t(3)**2*(u1%InflowOnBlade - u2%InflowOnBlade) + t(2)**2*(-u1%InflowOnBlade + u3%InflowOnBlade))/(t(2)*t(3)*(t(2) - t(3))) - c3 = ( (t(2)-t(3))*u1%InflowOnBlade + t(3)*u2%InflowOnBlade - t(2)*u3%InflowOnBlade ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%InflowOnBlade = u1%InflowOnBlade + b3 * t_out + c3 * t_out**2 - DEALLOCATE(b3) - DEALLOCATE(c3) + DO i3 = LBOUND(u_out%InflowOnBlade,3),UBOUND(u_out%InflowOnBlade,3) + DO i2 = LBOUND(u_out%InflowOnBlade,2),UBOUND(u_out%InflowOnBlade,2) + DO i1 = LBOUND(u_out%InflowOnBlade,1),UBOUND(u_out%InflowOnBlade,1) + b = (t(3)**2*(u1%InflowOnBlade(i1,i2,i3) - u2%InflowOnBlade(i1,i2,i3)) + t(2)**2*(-u1%InflowOnBlade(i1,i2,i3) + u3%InflowOnBlade(i1,i2,i3)))* scaleFactor + c = ( (t(2)-t(3))*u1%InflowOnBlade(i1,i2,i3) + t(3)*u2%InflowOnBlade(i1,i2,i3) - t(2)*u3%InflowOnBlade(i1,i2,i3) ) * scaleFactor + u_out%InflowOnBlade(i1,i2,i3) = u1%InflowOnBlade(i1,i2,i3) + b + c * t_out + END DO + END DO + END DO END IF ! check if allocated IF (ALLOCATED(u_out%InflowOnTower) .AND. ALLOCATED(u1%InflowOnTower)) THEN - ALLOCATE(b2(SIZE(u_out%InflowOnTower,1),SIZE(u_out%InflowOnTower,2) )) - ALLOCATE(c2(SIZE(u_out%InflowOnTower,1),SIZE(u_out%InflowOnTower,2) )) - b2 = (t(3)**2*(u1%InflowOnTower - u2%InflowOnTower) + t(2)**2*(-u1%InflowOnTower + u3%InflowOnTower))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%InflowOnTower + t(3)*u2%InflowOnTower - t(2)*u3%InflowOnTower ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%InflowOnTower = u1%InflowOnTower + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%InflowOnTower,2),UBOUND(u_out%InflowOnTower,2) + DO i1 = LBOUND(u_out%InflowOnTower,1),UBOUND(u_out%InflowOnTower,1) + b = (t(3)**2*(u1%InflowOnTower(i1,i2) - u2%InflowOnTower(i1,i2)) + t(2)**2*(-u1%InflowOnTower(i1,i2) + u3%InflowOnTower(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%InflowOnTower(i1,i2) + t(3)*u2%InflowOnTower(i1,i2) - t(2)*u3%InflowOnTower(i1,i2) ) * scaleFactor + u_out%InflowOnTower(i1,i2) = u1%InflowOnTower(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated IF (ALLOCATED(u_out%UserProp) .AND. ALLOCATED(u1%UserProp)) THEN - ALLOCATE(b2(SIZE(u_out%UserProp,1),SIZE(u_out%UserProp,2) )) - ALLOCATE(c2(SIZE(u_out%UserProp,1),SIZE(u_out%UserProp,2) )) - b2 = (t(3)**2*(u1%UserProp - u2%UserProp) + t(2)**2*(-u1%UserProp + u3%UserProp))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%UserProp + t(3)*u2%UserProp - t(2)*u3%UserProp ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%UserProp = u1%UserProp + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%UserProp,2),UBOUND(u_out%UserProp,2) + DO i1 = LBOUND(u_out%UserProp,1),UBOUND(u_out%UserProp,1) + b = (t(3)**2*(u1%UserProp(i1,i2) - u2%UserProp(i1,i2)) + t(2)**2*(-u1%UserProp(i1,i2) + u3%UserProp(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%UserProp(i1,i2) + t(3)*u2%UserProp(i1,i2) - t(2)*u3%UserProp(i1,i2) ) * scaleFactor + u_out%UserProp(i1,i2) = u1%UserProp(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated END SUBROUTINE AD_Input_ExtrapInterp2 @@ -8163,13 +8289,12 @@ SUBROUTINE AD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'AD_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -8182,21 +8307,21 @@ SUBROUTINE AD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(y1%TowerLoad, y2%TowerLoad, tin, y_out%TowerLoad, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%BladeLoad) .AND. ALLOCATED(y1%BladeLoad)) THEN - DO i01 = LBOUND(y_out%BladeLoad,1),UBOUND(y_out%BladeLoad,1) - CALL MeshExtrapInterp1(y1%BladeLoad(i01), y2%BladeLoad(i01), tin, y_out%BladeLoad(i01), tin_out, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(y_out%BladeLoad,1),UBOUND(y_out%BladeLoad,1) + CALL MeshExtrapInterp1(y1%BladeLoad(i1), y2%BladeLoad(i1), tin, y_out%BladeLoad(i1), tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) ENDDO END IF ! check if allocated IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = -(y1%WriteOutput - y2%WriteOutput)/t(2) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO END IF ! check if allocated END SUBROUTINE AD_Output_ExtrapInterp1 @@ -8227,14 +8352,14 @@ SUBROUTINE AD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'AD_Output_ExtrapInterp2' INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -8253,22 +8378,22 @@ SUBROUTINE AD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(y1%TowerLoad, y2%TowerLoad, y3%TowerLoad, tin, y_out%TowerLoad, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%BladeLoad) .AND. ALLOCATED(y1%BladeLoad)) THEN - DO i01 = LBOUND(y_out%BladeLoad,1),UBOUND(y_out%BladeLoad,1) - CALL MeshExtrapInterp2(y1%BladeLoad(i01), y2%BladeLoad(i01), y3%BladeLoad(i01), tin, y_out%BladeLoad(i01), tin_out, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(y_out%BladeLoad,1),UBOUND(y_out%BladeLoad,1) + CALL MeshExtrapInterp2(y1%BladeLoad(i1), y2%BladeLoad(i1), y3%BladeLoad(i1), tin, y_out%BladeLoad(i1), tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) ENDDO END IF ! check if allocated IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = (t(3)**2*(y1%WriteOutput - y2%WriteOutput) + t(2)**2*(-y1%WriteOutput + y3%WriteOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WriteOutput + t(3)*y2%WriteOutput - t(2)*y3%WriteOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO END IF ! check if allocated END SUBROUTINE AD_Output_ExtrapInterp2 diff --git a/modules/aerodyn/src/AirfoilInfo_Types.f90 b/modules/aerodyn/src/AirfoilInfo_Types.f90 index 0e78d0faf9..b278b1e95b 100644 --- a/modules/aerodyn/src/AirfoilInfo_Types.f90 +++ b/modules/aerodyn/src/AirfoilInfo_Types.f90 @@ -292,70 +292,70 @@ SUBROUTINE AFI_PackUA_BL_Type( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%alpha0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%alpha1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%alpha2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%eta_e - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%C_nalpha - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%T_f0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%T_V0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%T_p - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%T_VL - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%b1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%b2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%b5 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%A1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%A2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%A5 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%S1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%S2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%S3 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%S4 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cn1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cn2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%St_sh - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cd0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cm0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%k0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%k1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%k2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%k3 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%k1_hat - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%x_cp_bar - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%UACutout - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%filtCutOff - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%alpha0 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%alpha1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%alpha2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%eta_e + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%C_nalpha + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%T_f0 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%T_V0 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%T_p + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%T_VL + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%b1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%b2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%b5 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%A1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%A2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%A5 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%S1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%S2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%S3 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%S4 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cn1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cn2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%St_sh + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cd0 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cm0 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k0 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k3 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k1_hat + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%x_cp_bar + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%UACutout + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%filtCutOff + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AFI_PackUA_BL_Type SUBROUTINE AFI_UnPackUA_BL_Type( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -371,12 +371,6 @@ SUBROUTINE AFI_UnPackUA_BL_Type( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (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 @@ -393,70 +387,70 @@ SUBROUTINE AFI_UnPackUA_BL_Type( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%alpha0 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%alpha1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%alpha2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%eta_e = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%C_nalpha = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%T_f0 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%T_V0 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%T_p = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%T_VL = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%b1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%b2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%b5 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%A1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%A2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%A5 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%S1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%S2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%S3 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%S4 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cn1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cn2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%St_sh = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cd0 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cm0 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%k0 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%k1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%k2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%k3 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%k1_hat = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%x_cp_bar = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%UACutout = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%filtCutOff = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%alpha0 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%alpha1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%alpha2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%eta_e = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%C_nalpha = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%T_f0 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%T_V0 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%T_p = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%T_VL = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%b1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%b2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%b5 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%A1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%A2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%A5 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%S1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%S2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%S3 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%S4 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cn1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cn2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%St_sh = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cd0 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cm0 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%k0 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%k1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%k2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%k3 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%k1_hat = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%x_cp_bar = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%UACutout = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%filtCutOff = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AFI_UnPackUA_BL_Type SUBROUTINE AFI_CopyTable_Type( SrcTable_TypeData, DstTable_TypeData, CtrlCode, ErrStat, ErrMsg ) @@ -659,8 +653,10 @@ SUBROUTINE AFI_PackTable_Type( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Alpha,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Alpha)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Alpha))-1 ) = PACK(InData%Alpha,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Alpha) + DO i1 = LBOUND(InData%Alpha,1), UBOUND(InData%Alpha,1) + ReKiBuf(Re_Xferred) = InData%Alpha(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%Coefs) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -675,8 +671,12 @@ SUBROUTINE AFI_PackTable_Type( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Coefs,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Coefs)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Coefs))-1 ) = PACK(InData%Coefs,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Coefs) + DO i2 = LBOUND(InData%Coefs,2), UBOUND(InData%Coefs,2) + DO i1 = LBOUND(InData%Coefs,1), UBOUND(InData%Coefs,1) + ReKiBuf(Re_Xferred) = InData%Coefs(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%SplineCoefs) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -694,19 +694,25 @@ SUBROUTINE AFI_PackTable_Type( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SplineCoefs,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%SplineCoefs)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SplineCoefs))-1 ) = PACK(InData%SplineCoefs,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SplineCoefs) + DO i3 = LBOUND(InData%SplineCoefs,3), UBOUND(InData%SplineCoefs,3) + DO i2 = LBOUND(InData%SplineCoefs,2), UBOUND(InData%SplineCoefs,2) + DO i1 = LBOUND(InData%SplineCoefs,1), UBOUND(InData%SplineCoefs,1) + ReKiBuf(Re_Xferred) = InData%SplineCoefs(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%UserProp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Re - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumAlf - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%ConstData , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%InclUAdata , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%UserProp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Re + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumAlf + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%ConstData, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%InclUAdata, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 CALL AFI_Packua_bl_type( Re_Buf, Db_Buf, Int_Buf, InData%UA_BL, ErrStat2, ErrMsg2, OnlySize ) ! UA_BL CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -750,12 +756,6 @@ SUBROUTINE AFI_UnPackTable_Type( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (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 @@ -785,15 +785,10 @@ SUBROUTINE AFI_UnPackTable_Type( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Alpha.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Alpha)>0) OutData%Alpha = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Alpha))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Alpha) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Alpha,1), UBOUND(OutData%Alpha,1) + OutData%Alpha(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Coefs not allocated Int_Xferred = Int_Xferred + 1 @@ -811,15 +806,12 @@ SUBROUTINE AFI_UnPackTable_Type( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Coefs.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Coefs)>0) OutData%Coefs = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Coefs))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Coefs) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Coefs,2), UBOUND(OutData%Coefs,2) + DO i1 = LBOUND(OutData%Coefs,1), UBOUND(OutData%Coefs,1) + OutData%Coefs(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SplineCoefs not allocated Int_Xferred = Int_Xferred + 1 @@ -840,26 +832,25 @@ SUBROUTINE AFI_UnPackTable_Type( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SplineCoefs.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%SplineCoefs)>0) OutData%SplineCoefs = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SplineCoefs))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SplineCoefs) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%SplineCoefs,3), UBOUND(OutData%SplineCoefs,3) + DO i2 = LBOUND(OutData%SplineCoefs,2), UBOUND(OutData%SplineCoefs,2) + DO i1 = LBOUND(OutData%SplineCoefs,1), UBOUND(OutData%SplineCoefs,1) + OutData%SplineCoefs(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - OutData%UserProp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Re = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NumAlf = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%ConstData = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%InclUAdata = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%UserProp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Re = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NumAlf = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ConstData = TRANSFER(IntKiBuf(Int_Xferred), OutData%ConstData) + Int_Xferred = Int_Xferred + 1 + OutData%InclUAdata = TRANSFER(IntKiBuf(Int_Xferred), OutData%InclUAdata) + Int_Xferred = Int_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -1005,22 +996,22 @@ SUBROUTINE AFI_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%FileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%FileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%AFTabMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%InCol_Alfa - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%InCol_Cl - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%InCol_Cd - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%InCol_Cm - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%InCol_Cpmin - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%FileName) + IntKiBuf(Int_Xferred) = ICHAR(InData%FileName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%AFTabMod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%InCol_Alfa + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%InCol_Cl + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%InCol_Cd + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%InCol_Cm + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%InCol_Cpmin + Int_Xferred = Int_Xferred + 1 END SUBROUTINE AFI_PackInitInput SUBROUTINE AFI_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1036,12 +1027,6 @@ SUBROUTINE AFI_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AFI_UnPackInitInput' @@ -1055,22 +1040,22 @@ SUBROUTINE AFI_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%FileName) - OutData%FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%AFTabMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%InCol_Alfa = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%InCol_Cl = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%InCol_Cd = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%InCol_Cm = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%InCol_Cpmin = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%FileName) + OutData%FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%AFTabMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%InCol_Alfa = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%InCol_Cl = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%InCol_Cd = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%InCol_Cm = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%InCol_Cpmin = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE AFI_UnPackInitInput SUBROUTINE AFI_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -1227,12 +1212,6 @@ SUBROUTINE AFI_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AFI_UnPackInitOutput' @@ -1502,16 +1481,16 @@ SUBROUTINE AFI_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%ColCd - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%ColCl - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%ColCm - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%ColCpmin - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%AFTabMod - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%ColCd + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%ColCl + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%ColCm + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%ColCpmin + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%AFTabMod + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%secondVals) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1522,15 +1501,17 @@ SUBROUTINE AFI_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%secondVals,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%secondVals)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%secondVals))-1 ) = PACK(InData%secondVals,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%secondVals) + DO i1 = LBOUND(InData%secondVals,1), UBOUND(InData%secondVals,1) + ReKiBuf(Re_Xferred) = InData%secondVals(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%InterpOrd - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NonDimArea - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumCoords - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%InterpOrd + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NonDimArea + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumCoords + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%X_Coord) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1541,8 +1522,10 @@ SUBROUTINE AFI_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%X_Coord,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%X_Coord)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%X_Coord))-1 ) = PACK(InData%X_Coord,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%X_Coord) + DO i1 = LBOUND(InData%X_Coord,1), UBOUND(InData%X_Coord,1) + ReKiBuf(Re_Xferred) = InData%X_Coord(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%Y_Coord) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1554,11 +1537,13 @@ SUBROUTINE AFI_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Y_Coord,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Y_Coord)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Y_Coord))-1 ) = PACK(InData%Y_Coord,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Y_Coord) + DO i1 = LBOUND(InData%Y_Coord,1), UBOUND(InData%Y_Coord,1) + ReKiBuf(Re_Xferred) = InData%Y_Coord(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumTabs - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumTabs + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%Table) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1615,12 +1600,6 @@ SUBROUTINE AFI_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1635,16 +1614,16 @@ SUBROUTINE AFI_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%ColCd = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%ColCl = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%ColCm = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%ColCpmin = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%AFTabMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%ColCd = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ColCl = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ColCm = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ColCpmin = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%AFTabMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! secondVals not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1658,22 +1637,17 @@ SUBROUTINE AFI_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%secondVals.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%secondVals)>0) OutData%secondVals = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%secondVals))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%secondVals) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%secondVals,1), UBOUND(OutData%secondVals,1) + OutData%secondVals(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%InterpOrd = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NonDimArea = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NumCoords = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%InterpOrd = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NonDimArea = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NumCoords = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! X_Coord not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1687,15 +1661,10 @@ SUBROUTINE AFI_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%X_Coord.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%X_Coord)>0) OutData%X_Coord = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%X_Coord))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%X_Coord) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%X_Coord,1), UBOUND(OutData%X_Coord,1) + OutData%X_Coord(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Y_Coord not allocated Int_Xferred = Int_Xferred + 1 @@ -1710,18 +1679,13 @@ SUBROUTINE AFI_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Y_Coord.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Y_Coord)>0) OutData%Y_Coord = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Y_Coord))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Y_Coord) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Y_Coord,1), UBOUND(OutData%Y_Coord,1) + OutData%Y_Coord(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%NumTabs = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NumTabs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Table not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1875,12 +1839,12 @@ SUBROUTINE AFI_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AoA - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%UserProp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Re - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AoA + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%UserProp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Re + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AFI_PackInput SUBROUTINE AFI_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1896,12 +1860,6 @@ SUBROUTINE AFI_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AFI_UnPackInput' @@ -1915,12 +1873,12 @@ SUBROUTINE AFI_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%AoA = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%UserProp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Re = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%AoA = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%UserProp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Re = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AFI_UnPackInput SUBROUTINE AFI_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -2024,18 +1982,18 @@ SUBROUTINE AFI_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cl - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cd - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cm - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cpmin - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cd0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cm0 - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cl + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cd + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cm + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cpmin + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cd0 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cm0 + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AFI_PackOutput SUBROUTINE AFI_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2051,12 +2009,6 @@ SUBROUTINE AFI_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AFI_UnPackOutput' @@ -2070,18 +2022,18 @@ SUBROUTINE AFI_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%Cl = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cd = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cm = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cpmin = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cd0 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cm0 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%Cl = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cd = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cm = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cpmin = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cd0 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cm0 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AFI_UnPackOutput @@ -2159,8 +2111,8 @@ SUBROUTINE AFI_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg REAL(ReKi) :: t(2) ! Times associated with the Outputs REAL(ReKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'AFI_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -2175,18 +2127,20 @@ SUBROUTINE AFI_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - b0 = -(y1%Cl - y2%Cl)/t(2) - y_out%Cl = y1%Cl + b0 * t_out - b0 = -(y1%Cd - y2%Cd)/t(2) - y_out%Cd = y1%Cd + b0 * t_out - b0 = -(y1%Cm - y2%Cm)/t(2) - y_out%Cm = y1%Cm + b0 * t_out - b0 = -(y1%Cpmin - y2%Cpmin)/t(2) - y_out%Cpmin = y1%Cpmin + b0 * t_out - b0 = -(y1%Cd0 - y2%Cd0)/t(2) - y_out%Cd0 = y1%Cd0 + b0 * t_out - b0 = -(y1%Cm0 - y2%Cm0)/t(2) - y_out%Cm0 = y1%Cm0 + b0 * t_out + + ScaleFactor = t_out / t(2) + b = -(y1%Cl - y2%Cl) + y_out%Cl = y1%Cl + b * ScaleFactor + b = -(y1%Cd - y2%Cd) + y_out%Cd = y1%Cd + b * ScaleFactor + b = -(y1%Cm - y2%Cm) + y_out%Cm = y1%Cm + b * ScaleFactor + b = -(y1%Cpmin - y2%Cpmin) + y_out%Cpmin = y1%Cpmin + b * ScaleFactor + b = -(y1%Cd0 - y2%Cd0) + y_out%Cd0 = y1%Cd0 + b * ScaleFactor + b = -(y1%Cm0 - y2%Cm0) + y_out%Cm0 = y1%Cm0 + b * ScaleFactor END SUBROUTINE AFI_Output_ExtrapInterp1 @@ -2216,8 +2170,9 @@ SUBROUTINE AFI_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Er REAL(ReKi) :: t(3) ! Times associated with the Outputs REAL(ReKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'AFI_Output_ExtrapInterp2' @@ -2239,24 +2194,26 @@ SUBROUTINE AFI_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - b0 = (t(3)**2*(y1%Cl - y2%Cl) + t(2)**2*(-y1%Cl + y3%Cl))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%Cl + t(3)*y2%Cl - t(2)*y3%Cl ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Cl = y1%Cl + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%Cd - y2%Cd) + t(2)**2*(-y1%Cd + y3%Cd))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%Cd + t(3)*y2%Cd - t(2)*y3%Cd ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Cd = y1%Cd + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%Cm - y2%Cm) + t(2)**2*(-y1%Cm + y3%Cm))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%Cm + t(3)*y2%Cm - t(2)*y3%Cm ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Cm = y1%Cm + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%Cpmin - y2%Cpmin) + t(2)**2*(-y1%Cpmin + y3%Cpmin))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%Cpmin + t(3)*y2%Cpmin - t(2)*y3%Cpmin ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Cpmin = y1%Cpmin + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%Cd0 - y2%Cd0) + t(2)**2*(-y1%Cd0 + y3%Cd0))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%Cd0 + t(3)*y2%Cd0 - t(2)*y3%Cd0 ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Cd0 = y1%Cd0 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%Cm0 - y2%Cm0) + t(2)**2*(-y1%Cm0 + y3%Cm0))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%Cm0 + t(3)*y2%Cm0 - t(2)*y3%Cm0 ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Cm0 = y1%Cm0 + b0 * t_out + c0 * t_out**2 + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) + b = (t(3)**2*(y1%Cl - y2%Cl) + t(2)**2*(-y1%Cl + y3%Cl))* scaleFactor + c = ( (t(2)-t(3))*y1%Cl + t(3)*y2%Cl - t(2)*y3%Cl ) * scaleFactor + y_out%Cl = y1%Cl + b + c * t_out + b = (t(3)**2*(y1%Cd - y2%Cd) + t(2)**2*(-y1%Cd + y3%Cd))* scaleFactor + c = ( (t(2)-t(3))*y1%Cd + t(3)*y2%Cd - t(2)*y3%Cd ) * scaleFactor + y_out%Cd = y1%Cd + b + c * t_out + b = (t(3)**2*(y1%Cm - y2%Cm) + t(2)**2*(-y1%Cm + y3%Cm))* scaleFactor + c = ( (t(2)-t(3))*y1%Cm + t(3)*y2%Cm - t(2)*y3%Cm ) * scaleFactor + y_out%Cm = y1%Cm + b + c * t_out + b = (t(3)**2*(y1%Cpmin - y2%Cpmin) + t(2)**2*(-y1%Cpmin + y3%Cpmin))* scaleFactor + c = ( (t(2)-t(3))*y1%Cpmin + t(3)*y2%Cpmin - t(2)*y3%Cpmin ) * scaleFactor + y_out%Cpmin = y1%Cpmin + b + c * t_out + b = (t(3)**2*(y1%Cd0 - y2%Cd0) + t(2)**2*(-y1%Cd0 + y3%Cd0))* scaleFactor + c = ( (t(2)-t(3))*y1%Cd0 + t(3)*y2%Cd0 - t(2)*y3%Cd0 ) * scaleFactor + y_out%Cd0 = y1%Cd0 + b + c * t_out + b = (t(3)**2*(y1%Cm0 - y2%Cm0) + t(2)**2*(-y1%Cm0 + y3%Cm0))* scaleFactor + c = ( (t(2)-t(3))*y1%Cm0 + t(3)*y2%Cm0 - t(2)*y3%Cm0 ) * scaleFactor + y_out%Cm0 = y1%Cm0 + b + c * t_out END SUBROUTINE AFI_Output_ExtrapInterp2 @@ -2334,8 +2291,8 @@ SUBROUTINE AFI_UA_BL_Type_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, Er REAL(ReKi) :: t(2) ! Times associated with the UA_BL_Types REAL(ReKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'AFI_UA_BL_Type_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -2350,70 +2307,72 @@ SUBROUTINE AFI_UA_BL_Type_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - b0 = -(u1%alpha0 - u2%alpha0)/t(2) - u_out%alpha0 = u1%alpha0 + b0 * t_out - b0 = -(u1%alpha1 - u2%alpha1)/t(2) - u_out%alpha1 = u1%alpha1 + b0 * t_out - b0 = -(u1%alpha2 - u2%alpha2)/t(2) - u_out%alpha2 = u1%alpha2 + b0 * t_out - b0 = -(u1%eta_e - u2%eta_e)/t(2) - u_out%eta_e = u1%eta_e + b0 * t_out - b0 = -(u1%C_nalpha - u2%C_nalpha)/t(2) - u_out%C_nalpha = u1%C_nalpha + b0 * t_out - b0 = -(u1%T_f0 - u2%T_f0)/t(2) - u_out%T_f0 = u1%T_f0 + b0 * t_out - b0 = -(u1%T_V0 - u2%T_V0)/t(2) - u_out%T_V0 = u1%T_V0 + b0 * t_out - b0 = -(u1%T_p - u2%T_p)/t(2) - u_out%T_p = u1%T_p + b0 * t_out - b0 = -(u1%T_VL - u2%T_VL)/t(2) - u_out%T_VL = u1%T_VL + b0 * t_out - b0 = -(u1%b1 - u2%b1)/t(2) - u_out%b1 = u1%b1 + b0 * t_out - b0 = -(u1%b2 - u2%b2)/t(2) - u_out%b2 = u1%b2 + b0 * t_out - b0 = -(u1%b5 - u2%b5)/t(2) - u_out%b5 = u1%b5 + b0 * t_out - b0 = -(u1%A1 - u2%A1)/t(2) - u_out%A1 = u1%A1 + b0 * t_out - b0 = -(u1%A2 - u2%A2)/t(2) - u_out%A2 = u1%A2 + b0 * t_out - b0 = -(u1%A5 - u2%A5)/t(2) - u_out%A5 = u1%A5 + b0 * t_out - b0 = -(u1%S1 - u2%S1)/t(2) - u_out%S1 = u1%S1 + b0 * t_out - b0 = -(u1%S2 - u2%S2)/t(2) - u_out%S2 = u1%S2 + b0 * t_out - b0 = -(u1%S3 - u2%S3)/t(2) - u_out%S3 = u1%S3 + b0 * t_out - b0 = -(u1%S4 - u2%S4)/t(2) - u_out%S4 = u1%S4 + b0 * t_out - b0 = -(u1%Cn1 - u2%Cn1)/t(2) - u_out%Cn1 = u1%Cn1 + b0 * t_out - b0 = -(u1%Cn2 - u2%Cn2)/t(2) - u_out%Cn2 = u1%Cn2 + b0 * t_out - b0 = -(u1%St_sh - u2%St_sh)/t(2) - u_out%St_sh = u1%St_sh + b0 * t_out - b0 = -(u1%Cd0 - u2%Cd0)/t(2) - u_out%Cd0 = u1%Cd0 + b0 * t_out - b0 = -(u1%Cm0 - u2%Cm0)/t(2) - u_out%Cm0 = u1%Cm0 + b0 * t_out - b0 = -(u1%k0 - u2%k0)/t(2) - u_out%k0 = u1%k0 + b0 * t_out - b0 = -(u1%k1 - u2%k1)/t(2) - u_out%k1 = u1%k1 + b0 * t_out - b0 = -(u1%k2 - u2%k2)/t(2) - u_out%k2 = u1%k2 + b0 * t_out - b0 = -(u1%k3 - u2%k3)/t(2) - u_out%k3 = u1%k3 + b0 * t_out - b0 = -(u1%k1_hat - u2%k1_hat)/t(2) - u_out%k1_hat = u1%k1_hat + b0 * t_out - b0 = -(u1%x_cp_bar - u2%x_cp_bar)/t(2) - u_out%x_cp_bar = u1%x_cp_bar + b0 * t_out - b0 = -(u1%UACutout - u2%UACutout)/t(2) - u_out%UACutout = u1%UACutout + b0 * t_out - b0 = -(u1%filtCutOff - u2%filtCutOff)/t(2) - u_out%filtCutOff = u1%filtCutOff + b0 * t_out + + ScaleFactor = t_out / t(2) + b = -(u1%alpha0 - u2%alpha0) + u_out%alpha0 = u1%alpha0 + b * ScaleFactor + b = -(u1%alpha1 - u2%alpha1) + u_out%alpha1 = u1%alpha1 + b * ScaleFactor + b = -(u1%alpha2 - u2%alpha2) + u_out%alpha2 = u1%alpha2 + b * ScaleFactor + b = -(u1%eta_e - u2%eta_e) + u_out%eta_e = u1%eta_e + b * ScaleFactor + b = -(u1%C_nalpha - u2%C_nalpha) + u_out%C_nalpha = u1%C_nalpha + b * ScaleFactor + b = -(u1%T_f0 - u2%T_f0) + u_out%T_f0 = u1%T_f0 + b * ScaleFactor + b = -(u1%T_V0 - u2%T_V0) + u_out%T_V0 = u1%T_V0 + b * ScaleFactor + b = -(u1%T_p - u2%T_p) + u_out%T_p = u1%T_p + b * ScaleFactor + b = -(u1%T_VL - u2%T_VL) + u_out%T_VL = u1%T_VL + b * ScaleFactor + b = -(u1%b1 - u2%b1) + u_out%b1 = u1%b1 + b * ScaleFactor + b = -(u1%b2 - u2%b2) + u_out%b2 = u1%b2 + b * ScaleFactor + b = -(u1%b5 - u2%b5) + u_out%b5 = u1%b5 + b * ScaleFactor + b = -(u1%A1 - u2%A1) + u_out%A1 = u1%A1 + b * ScaleFactor + b = -(u1%A2 - u2%A2) + u_out%A2 = u1%A2 + b * ScaleFactor + b = -(u1%A5 - u2%A5) + u_out%A5 = u1%A5 + b * ScaleFactor + b = -(u1%S1 - u2%S1) + u_out%S1 = u1%S1 + b * ScaleFactor + b = -(u1%S2 - u2%S2) + u_out%S2 = u1%S2 + b * ScaleFactor + b = -(u1%S3 - u2%S3) + u_out%S3 = u1%S3 + b * ScaleFactor + b = -(u1%S4 - u2%S4) + u_out%S4 = u1%S4 + b * ScaleFactor + b = -(u1%Cn1 - u2%Cn1) + u_out%Cn1 = u1%Cn1 + b * ScaleFactor + b = -(u1%Cn2 - u2%Cn2) + u_out%Cn2 = u1%Cn2 + b * ScaleFactor + b = -(u1%St_sh - u2%St_sh) + u_out%St_sh = u1%St_sh + b * ScaleFactor + b = -(u1%Cd0 - u2%Cd0) + u_out%Cd0 = u1%Cd0 + b * ScaleFactor + b = -(u1%Cm0 - u2%Cm0) + u_out%Cm0 = u1%Cm0 + b * ScaleFactor + b = -(u1%k0 - u2%k0) + u_out%k0 = u1%k0 + b * ScaleFactor + b = -(u1%k1 - u2%k1) + u_out%k1 = u1%k1 + b * ScaleFactor + b = -(u1%k2 - u2%k2) + u_out%k2 = u1%k2 + b * ScaleFactor + b = -(u1%k3 - u2%k3) + u_out%k3 = u1%k3 + b * ScaleFactor + b = -(u1%k1_hat - u2%k1_hat) + u_out%k1_hat = u1%k1_hat + b * ScaleFactor + b = -(u1%x_cp_bar - u2%x_cp_bar) + u_out%x_cp_bar = u1%x_cp_bar + b * ScaleFactor + b = -(u1%UACutout - u2%UACutout) + u_out%UACutout = u1%UACutout + b * ScaleFactor + b = -(u1%filtCutOff - u2%filtCutOff) + u_out%filtCutOff = u1%filtCutOff + b * ScaleFactor END SUBROUTINE AFI_UA_BL_Type_ExtrapInterp1 @@ -2443,8 +2402,9 @@ SUBROUTINE AFI_UA_BL_Type_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat REAL(ReKi) :: t(3) ! Times associated with the UA_BL_Types REAL(ReKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'AFI_UA_BL_Type_ExtrapInterp2' @@ -2466,102 +2426,104 @@ SUBROUTINE AFI_UA_BL_Type_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - b0 = (t(3)**2*(u1%alpha0 - u2%alpha0) + t(2)**2*(-u1%alpha0 + u3%alpha0))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%alpha0 + t(3)*u2%alpha0 - t(2)*u3%alpha0 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%alpha0 = u1%alpha0 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%alpha1 - u2%alpha1) + t(2)**2*(-u1%alpha1 + u3%alpha1))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%alpha1 + t(3)*u2%alpha1 - t(2)*u3%alpha1 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%alpha1 = u1%alpha1 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%alpha2 - u2%alpha2) + t(2)**2*(-u1%alpha2 + u3%alpha2))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%alpha2 + t(3)*u2%alpha2 - t(2)*u3%alpha2 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%alpha2 = u1%alpha2 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%eta_e - u2%eta_e) + t(2)**2*(-u1%eta_e + u3%eta_e))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%eta_e + t(3)*u2%eta_e - t(2)*u3%eta_e ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%eta_e = u1%eta_e + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%C_nalpha - u2%C_nalpha) + t(2)**2*(-u1%C_nalpha + u3%C_nalpha))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%C_nalpha + t(3)*u2%C_nalpha - t(2)*u3%C_nalpha ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%C_nalpha = u1%C_nalpha + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%T_f0 - u2%T_f0) + t(2)**2*(-u1%T_f0 + u3%T_f0))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%T_f0 + t(3)*u2%T_f0 - t(2)*u3%T_f0 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%T_f0 = u1%T_f0 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%T_V0 - u2%T_V0) + t(2)**2*(-u1%T_V0 + u3%T_V0))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%T_V0 + t(3)*u2%T_V0 - t(2)*u3%T_V0 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%T_V0 = u1%T_V0 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%T_p - u2%T_p) + t(2)**2*(-u1%T_p + u3%T_p))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%T_p + t(3)*u2%T_p - t(2)*u3%T_p ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%T_p = u1%T_p + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%T_VL - u2%T_VL) + t(2)**2*(-u1%T_VL + u3%T_VL))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%T_VL + t(3)*u2%T_VL - t(2)*u3%T_VL ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%T_VL = u1%T_VL + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%b1 - u2%b1) + t(2)**2*(-u1%b1 + u3%b1))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%b1 + t(3)*u2%b1 - t(2)*u3%b1 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%b1 = u1%b1 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%b2 - u2%b2) + t(2)**2*(-u1%b2 + u3%b2))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%b2 + t(3)*u2%b2 - t(2)*u3%b2 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%b2 = u1%b2 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%b5 - u2%b5) + t(2)**2*(-u1%b5 + u3%b5))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%b5 + t(3)*u2%b5 - t(2)*u3%b5 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%b5 = u1%b5 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%A1 - u2%A1) + t(2)**2*(-u1%A1 + u3%A1))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%A1 + t(3)*u2%A1 - t(2)*u3%A1 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%A1 = u1%A1 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%A2 - u2%A2) + t(2)**2*(-u1%A2 + u3%A2))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%A2 + t(3)*u2%A2 - t(2)*u3%A2 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%A2 = u1%A2 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%A5 - u2%A5) + t(2)**2*(-u1%A5 + u3%A5))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%A5 + t(3)*u2%A5 - t(2)*u3%A5 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%A5 = u1%A5 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%S1 - u2%S1) + t(2)**2*(-u1%S1 + u3%S1))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%S1 + t(3)*u2%S1 - t(2)*u3%S1 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%S1 = u1%S1 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%S2 - u2%S2) + t(2)**2*(-u1%S2 + u3%S2))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%S2 + t(3)*u2%S2 - t(2)*u3%S2 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%S2 = u1%S2 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%S3 - u2%S3) + t(2)**2*(-u1%S3 + u3%S3))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%S3 + t(3)*u2%S3 - t(2)*u3%S3 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%S3 = u1%S3 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%S4 - u2%S4) + t(2)**2*(-u1%S4 + u3%S4))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%S4 + t(3)*u2%S4 - t(2)*u3%S4 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%S4 = u1%S4 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%Cn1 - u2%Cn1) + t(2)**2*(-u1%Cn1 + u3%Cn1))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%Cn1 + t(3)*u2%Cn1 - t(2)*u3%Cn1 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Cn1 = u1%Cn1 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%Cn2 - u2%Cn2) + t(2)**2*(-u1%Cn2 + u3%Cn2))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%Cn2 + t(3)*u2%Cn2 - t(2)*u3%Cn2 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Cn2 = u1%Cn2 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%St_sh - u2%St_sh) + t(2)**2*(-u1%St_sh + u3%St_sh))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%St_sh + t(3)*u2%St_sh - t(2)*u3%St_sh ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%St_sh = u1%St_sh + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%Cd0 - u2%Cd0) + t(2)**2*(-u1%Cd0 + u3%Cd0))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%Cd0 + t(3)*u2%Cd0 - t(2)*u3%Cd0 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Cd0 = u1%Cd0 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%Cm0 - u2%Cm0) + t(2)**2*(-u1%Cm0 + u3%Cm0))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%Cm0 + t(3)*u2%Cm0 - t(2)*u3%Cm0 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Cm0 = u1%Cm0 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%k0 - u2%k0) + t(2)**2*(-u1%k0 + u3%k0))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%k0 + t(3)*u2%k0 - t(2)*u3%k0 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%k0 = u1%k0 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%k1 - u2%k1) + t(2)**2*(-u1%k1 + u3%k1))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%k1 + t(3)*u2%k1 - t(2)*u3%k1 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%k1 = u1%k1 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%k2 - u2%k2) + t(2)**2*(-u1%k2 + u3%k2))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%k2 + t(3)*u2%k2 - t(2)*u3%k2 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%k2 = u1%k2 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%k3 - u2%k3) + t(2)**2*(-u1%k3 + u3%k3))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%k3 + t(3)*u2%k3 - t(2)*u3%k3 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%k3 = u1%k3 + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%k1_hat - u2%k1_hat) + t(2)**2*(-u1%k1_hat + u3%k1_hat))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%k1_hat + t(3)*u2%k1_hat - t(2)*u3%k1_hat ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%k1_hat = u1%k1_hat + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%x_cp_bar - u2%x_cp_bar) + t(2)**2*(-u1%x_cp_bar + u3%x_cp_bar))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%x_cp_bar + t(3)*u2%x_cp_bar - t(2)*u3%x_cp_bar ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%x_cp_bar = u1%x_cp_bar + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%UACutout - u2%UACutout) + t(2)**2*(-u1%UACutout + u3%UACutout))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%UACutout + t(3)*u2%UACutout - t(2)*u3%UACutout ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%UACutout = u1%UACutout + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%filtCutOff - u2%filtCutOff) + t(2)**2*(-u1%filtCutOff + u3%filtCutOff))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%filtCutOff + t(3)*u2%filtCutOff - t(2)*u3%filtCutOff ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%filtCutOff = u1%filtCutOff + b0 * t_out + c0 * t_out**2 + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) + b = (t(3)**2*(u1%alpha0 - u2%alpha0) + t(2)**2*(-u1%alpha0 + u3%alpha0))* scaleFactor + c = ( (t(2)-t(3))*u1%alpha0 + t(3)*u2%alpha0 - t(2)*u3%alpha0 ) * scaleFactor + u_out%alpha0 = u1%alpha0 + b + c * t_out + b = (t(3)**2*(u1%alpha1 - u2%alpha1) + t(2)**2*(-u1%alpha1 + u3%alpha1))* scaleFactor + c = ( (t(2)-t(3))*u1%alpha1 + t(3)*u2%alpha1 - t(2)*u3%alpha1 ) * scaleFactor + u_out%alpha1 = u1%alpha1 + b + c * t_out + b = (t(3)**2*(u1%alpha2 - u2%alpha2) + t(2)**2*(-u1%alpha2 + u3%alpha2))* scaleFactor + c = ( (t(2)-t(3))*u1%alpha2 + t(3)*u2%alpha2 - t(2)*u3%alpha2 ) * scaleFactor + u_out%alpha2 = u1%alpha2 + b + c * t_out + b = (t(3)**2*(u1%eta_e - u2%eta_e) + t(2)**2*(-u1%eta_e + u3%eta_e))* scaleFactor + c = ( (t(2)-t(3))*u1%eta_e + t(3)*u2%eta_e - t(2)*u3%eta_e ) * scaleFactor + u_out%eta_e = u1%eta_e + b + c * t_out + b = (t(3)**2*(u1%C_nalpha - u2%C_nalpha) + t(2)**2*(-u1%C_nalpha + u3%C_nalpha))* scaleFactor + c = ( (t(2)-t(3))*u1%C_nalpha + t(3)*u2%C_nalpha - t(2)*u3%C_nalpha ) * scaleFactor + u_out%C_nalpha = u1%C_nalpha + b + c * t_out + b = (t(3)**2*(u1%T_f0 - u2%T_f0) + t(2)**2*(-u1%T_f0 + u3%T_f0))* scaleFactor + c = ( (t(2)-t(3))*u1%T_f0 + t(3)*u2%T_f0 - t(2)*u3%T_f0 ) * scaleFactor + u_out%T_f0 = u1%T_f0 + b + c * t_out + b = (t(3)**2*(u1%T_V0 - u2%T_V0) + t(2)**2*(-u1%T_V0 + u3%T_V0))* scaleFactor + c = ( (t(2)-t(3))*u1%T_V0 + t(3)*u2%T_V0 - t(2)*u3%T_V0 ) * scaleFactor + u_out%T_V0 = u1%T_V0 + b + c * t_out + b = (t(3)**2*(u1%T_p - u2%T_p) + t(2)**2*(-u1%T_p + u3%T_p))* scaleFactor + c = ( (t(2)-t(3))*u1%T_p + t(3)*u2%T_p - t(2)*u3%T_p ) * scaleFactor + u_out%T_p = u1%T_p + b + c * t_out + b = (t(3)**2*(u1%T_VL - u2%T_VL) + t(2)**2*(-u1%T_VL + u3%T_VL))* scaleFactor + c = ( (t(2)-t(3))*u1%T_VL + t(3)*u2%T_VL - t(2)*u3%T_VL ) * scaleFactor + u_out%T_VL = u1%T_VL + b + c * t_out + b = (t(3)**2*(u1%b1 - u2%b1) + t(2)**2*(-u1%b1 + u3%b1))* scaleFactor + c = ( (t(2)-t(3))*u1%b1 + t(3)*u2%b1 - t(2)*u3%b1 ) * scaleFactor + u_out%b1 = u1%b1 + b + c * t_out + b = (t(3)**2*(u1%b2 - u2%b2) + t(2)**2*(-u1%b2 + u3%b2))* scaleFactor + c = ( (t(2)-t(3))*u1%b2 + t(3)*u2%b2 - t(2)*u3%b2 ) * scaleFactor + u_out%b2 = u1%b2 + b + c * t_out + b = (t(3)**2*(u1%b5 - u2%b5) + t(2)**2*(-u1%b5 + u3%b5))* scaleFactor + c = ( (t(2)-t(3))*u1%b5 + t(3)*u2%b5 - t(2)*u3%b5 ) * scaleFactor + u_out%b5 = u1%b5 + b + c * t_out + b = (t(3)**2*(u1%A1 - u2%A1) + t(2)**2*(-u1%A1 + u3%A1))* scaleFactor + c = ( (t(2)-t(3))*u1%A1 + t(3)*u2%A1 - t(2)*u3%A1 ) * scaleFactor + u_out%A1 = u1%A1 + b + c * t_out + b = (t(3)**2*(u1%A2 - u2%A2) + t(2)**2*(-u1%A2 + u3%A2))* scaleFactor + c = ( (t(2)-t(3))*u1%A2 + t(3)*u2%A2 - t(2)*u3%A2 ) * scaleFactor + u_out%A2 = u1%A2 + b + c * t_out + b = (t(3)**2*(u1%A5 - u2%A5) + t(2)**2*(-u1%A5 + u3%A5))* scaleFactor + c = ( (t(2)-t(3))*u1%A5 + t(3)*u2%A5 - t(2)*u3%A5 ) * scaleFactor + u_out%A5 = u1%A5 + b + c * t_out + b = (t(3)**2*(u1%S1 - u2%S1) + t(2)**2*(-u1%S1 + u3%S1))* scaleFactor + c = ( (t(2)-t(3))*u1%S1 + t(3)*u2%S1 - t(2)*u3%S1 ) * scaleFactor + u_out%S1 = u1%S1 + b + c * t_out + b = (t(3)**2*(u1%S2 - u2%S2) + t(2)**2*(-u1%S2 + u3%S2))* scaleFactor + c = ( (t(2)-t(3))*u1%S2 + t(3)*u2%S2 - t(2)*u3%S2 ) * scaleFactor + u_out%S2 = u1%S2 + b + c * t_out + b = (t(3)**2*(u1%S3 - u2%S3) + t(2)**2*(-u1%S3 + u3%S3))* scaleFactor + c = ( (t(2)-t(3))*u1%S3 + t(3)*u2%S3 - t(2)*u3%S3 ) * scaleFactor + u_out%S3 = u1%S3 + b + c * t_out + b = (t(3)**2*(u1%S4 - u2%S4) + t(2)**2*(-u1%S4 + u3%S4))* scaleFactor + c = ( (t(2)-t(3))*u1%S4 + t(3)*u2%S4 - t(2)*u3%S4 ) * scaleFactor + u_out%S4 = u1%S4 + b + c * t_out + b = (t(3)**2*(u1%Cn1 - u2%Cn1) + t(2)**2*(-u1%Cn1 + u3%Cn1))* scaleFactor + c = ( (t(2)-t(3))*u1%Cn1 + t(3)*u2%Cn1 - t(2)*u3%Cn1 ) * scaleFactor + u_out%Cn1 = u1%Cn1 + b + c * t_out + b = (t(3)**2*(u1%Cn2 - u2%Cn2) + t(2)**2*(-u1%Cn2 + u3%Cn2))* scaleFactor + c = ( (t(2)-t(3))*u1%Cn2 + t(3)*u2%Cn2 - t(2)*u3%Cn2 ) * scaleFactor + u_out%Cn2 = u1%Cn2 + b + c * t_out + b = (t(3)**2*(u1%St_sh - u2%St_sh) + t(2)**2*(-u1%St_sh + u3%St_sh))* scaleFactor + c = ( (t(2)-t(3))*u1%St_sh + t(3)*u2%St_sh - t(2)*u3%St_sh ) * scaleFactor + u_out%St_sh = u1%St_sh + b + c * t_out + b = (t(3)**2*(u1%Cd0 - u2%Cd0) + t(2)**2*(-u1%Cd0 + u3%Cd0))* scaleFactor + c = ( (t(2)-t(3))*u1%Cd0 + t(3)*u2%Cd0 - t(2)*u3%Cd0 ) * scaleFactor + u_out%Cd0 = u1%Cd0 + b + c * t_out + b = (t(3)**2*(u1%Cm0 - u2%Cm0) + t(2)**2*(-u1%Cm0 + u3%Cm0))* scaleFactor + c = ( (t(2)-t(3))*u1%Cm0 + t(3)*u2%Cm0 - t(2)*u3%Cm0 ) * scaleFactor + u_out%Cm0 = u1%Cm0 + b + c * t_out + b = (t(3)**2*(u1%k0 - u2%k0) + t(2)**2*(-u1%k0 + u3%k0))* scaleFactor + c = ( (t(2)-t(3))*u1%k0 + t(3)*u2%k0 - t(2)*u3%k0 ) * scaleFactor + u_out%k0 = u1%k0 + b + c * t_out + b = (t(3)**2*(u1%k1 - u2%k1) + t(2)**2*(-u1%k1 + u3%k1))* scaleFactor + c = ( (t(2)-t(3))*u1%k1 + t(3)*u2%k1 - t(2)*u3%k1 ) * scaleFactor + u_out%k1 = u1%k1 + b + c * t_out + b = (t(3)**2*(u1%k2 - u2%k2) + t(2)**2*(-u1%k2 + u3%k2))* scaleFactor + c = ( (t(2)-t(3))*u1%k2 + t(3)*u2%k2 - t(2)*u3%k2 ) * scaleFactor + u_out%k2 = u1%k2 + b + c * t_out + b = (t(3)**2*(u1%k3 - u2%k3) + t(2)**2*(-u1%k3 + u3%k3))* scaleFactor + c = ( (t(2)-t(3))*u1%k3 + t(3)*u2%k3 - t(2)*u3%k3 ) * scaleFactor + u_out%k3 = u1%k3 + b + c * t_out + b = (t(3)**2*(u1%k1_hat - u2%k1_hat) + t(2)**2*(-u1%k1_hat + u3%k1_hat))* scaleFactor + c = ( (t(2)-t(3))*u1%k1_hat + t(3)*u2%k1_hat - t(2)*u3%k1_hat ) * scaleFactor + u_out%k1_hat = u1%k1_hat + b + c * t_out + b = (t(3)**2*(u1%x_cp_bar - u2%x_cp_bar) + t(2)**2*(-u1%x_cp_bar + u3%x_cp_bar))* scaleFactor + c = ( (t(2)-t(3))*u1%x_cp_bar + t(3)*u2%x_cp_bar - t(2)*u3%x_cp_bar ) * scaleFactor + u_out%x_cp_bar = u1%x_cp_bar + b + c * t_out + b = (t(3)**2*(u1%UACutout - u2%UACutout) + t(2)**2*(-u1%UACutout + u3%UACutout))* scaleFactor + c = ( (t(2)-t(3))*u1%UACutout + t(3)*u2%UACutout - t(2)*u3%UACutout ) * scaleFactor + u_out%UACutout = u1%UACutout + b + c * t_out + b = (t(3)**2*(u1%filtCutOff - u2%filtCutOff) + t(2)**2*(-u1%filtCutOff + u3%filtCutOff))* scaleFactor + c = ( (t(2)-t(3))*u1%filtCutOff + t(3)*u2%filtCutOff - t(2)*u3%filtCutOff ) * scaleFactor + u_out%filtCutOff = u1%filtCutOff + b + c * t_out END SUBROUTINE AFI_UA_BL_Type_ExtrapInterp2 END MODULE AirfoilInfo_Types diff --git a/modules/aerodyn/src/BEMT.f90 b/modules/aerodyn/src/BEMT.f90 index eb5f8b9681..5ae4ffcf9d 100644 --- a/modules/aerodyn/src/BEMT.f90 +++ b/modules/aerodyn/src/BEMT.f90 @@ -431,21 +431,6 @@ subroutine BEMT_AllocOutput( y, p, errStat, errMsg ) end subroutine BEMT_AllocOutput - -subroutine BEMT_MapOutputs(p, OtherState, y, errStat, errMsg) - - type(BEMT_ParameterType), intent(in ) :: p ! Parameters - type(BEMT_OtherStateType), intent(in ) :: OtherState ! other states - type(BEMT_OutputType), intent(inout) :: y ! system outputs - integer(IntKi), intent( out) :: errStat ! Error status of the operation - character(*), intent( out) :: errMsg ! Error message if ErrStat /= ErrID_None - - ErrStat = ErrID_None - ErrMsg = "" - -end subroutine BEMT_MapOutputs - - !---------------------------------------------------------------------------------------------------------------------------------- subroutine BEMT_Init( InitInp, u, p, x, xd, z, OtherState, AFInfo, y, misc, Interval, InitOut, ErrStat, ErrMsg ) ! This routine is called at the start of the simulation to perform initialization steps. @@ -464,7 +449,7 @@ subroutine BEMT_Init( InitInp, u, p, x, xd, z, OtherState, AFInfo, y, misc, Inte type(AFI_ParameterType), intent(in ) :: AFInfo(:) ! The airfoil parameter data type(BEMT_OutputType), intent( out) :: y ! Initial system outputs (outputs are not calculated; ! only the output mesh is initialized) - real(DbKi), intent(inout) :: interval ! Coupling interval in seconds: the rate that + real(DbKi), intent(in ) :: interval ! Coupling interval in seconds: the rate that ! (1) BEMT_UpdateStates() is called in loose coupling & ! (2) BEMT_UpdateDiscState() is called in tight coupling. ! Input is the suggested time from the glue code; @@ -647,25 +632,6 @@ subroutine BEMT_Init( InitInp, u, p, x, xd, z, OtherState, AFInfo, y, misc, Inte call AllocAry(misc%TanInduction,p%numBladeNodes,p%numBlades,'misc%TanInduction', errStat2,errMsg2); call SetErrStat(errStat2,errMsg2,errStat,errMsg,RoutineName) call AllocAry(misc%Rtip,p%numBlades,'misc%Rtip', errStat2,errMsg2); call SetErrStat(errStat2,errMsg2,errStat,errMsg,RoutineName) - !............................................................................................ - ! If you want to choose your own rate instead of using what the glue code suggests, tell the glue code the rate at which - ! this module must be called here: - !............................................................................................ - - Interval = p%DT - - - ! Print the summary file if requested: - !IF (InputFileData%SumPrint) THEN - ! CALL BEMT_PrintSum( p, OtherState, GetAdamsVals, ErrStat2, ErrMsg2 ) - ! call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - !END IF - - ! Destroy the InputFileData structure (deallocate arrays) - - !CALL BEMT_DestroyInputFile(InputFileData, ErrStat2, ErrMsg2 ) - ! call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - CONTAINS !............................................................................................................................... SUBROUTINE Cleanup() @@ -1198,12 +1164,6 @@ end subroutine calculate_Inductions_from_DBEMT !---------------------------------------------------------------------------------------------------------------------------------- subroutine BEMT_CalcOutput( t, u, p, x, xd, z, OtherState, AFInfo, y, m, errStat, errMsg ) ! Routine for computing outputs, used in both loose and tight coupling. -! This SUBROUTINE is used to compute the output channels (motions and loads) and place them in the WriteOutput() array. -! NOTE: the descriptions of the output channels are not given here. Please see the included OutListParameters.xlsx sheet for -! for a complete description of each output parameter. -! NOTE: no matter how many channels are selected for output, all of the outputs are calculated -! All of the calculated output channels are placed into the OtherState%AllOuts(:), while the channels selected for outputs are -! placed in the y%WriteOutput(:) array. !.................................................................................................................................. @@ -1241,7 +1201,6 @@ subroutine BEMT_CalcOutput( t, u, p, x, xd, z, OtherState, AFInfo, y, m, errStat integer(IntKi) :: k #endif - logical, parameter :: UpdateValues = .TRUE. ! determines if the OtherState values need to be updated logical :: IsValidSolution !< this is set to false if k<=1 in propeller brake region or k<-1 in momentum region, indicating an invalid solution ! Initialize some output values errStat = ErrID_None @@ -1305,16 +1264,6 @@ subroutine BEMT_CalcOutput( t, u, p, x, xd, z, OtherState, AFInfo, y, m, errStat end if end if - ! Array OtherState%AllOuts() is initialized to 0.0 in initialization, so we are not going to reinitialize it here. - - - !............................................................................................................................... - ! Calculate all of the total forces and moments using all of the partial forces and moments calculated in RtHS(). Also, - ! calculate all of the total angular and linear accelerations using all of the partial accelerations calculated in RtHS(). - ! To do this, first initialize the variables using the portions not associated with the accelerations. Then add the portions - ! associated with the accelerations one by one: - !............................................................................................................................... - do j = 1,p%numBlades ! Loop through all blades ! Locate the maximum rlocal value for this time step and this blade. This is passed to the solve as Rtip @@ -1424,29 +1373,6 @@ subroutine BEMT_CalcOutput( t, u, p, x, xd, z, OtherState, AFInfo, y, m, errStat ! end if #endif - !............................................................................................................................... - ! Place the selected output channels into the WriteOutput(:) array with the proper sign: - !............................................................................................................................... - - call BEMT_MapOutputs(p, OtherState, y, errStat2, errMsg2) - call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - if (errStat >= AbortErrLev) return - - !DO I = 1,p%NumOuts ! Loop through all selected output channels - ! - ! y%WriteOutput(I) = p%OutParam(I)%SignM * OtherState%AllOuts( p%OutParam(I)%Indx ) - ! - !ENDDO ! I - All selected output channels - - - !............................................................................................................................... - ! Outputs required for AeroDyn - !............................................................................................................................... - - !........... - ! Blade elements: - !........... - return diff --git a/modules/aerodyn/src/BEMT_Types.f90 b/modules/aerodyn/src/BEMT_Types.f90 index 5388d79a12..a5450d6eb5 100644 --- a/modules/aerodyn/src/BEMT_Types.f90 +++ b/modules/aerodyn/src/BEMT_Types.f90 @@ -446,37 +446,41 @@ SUBROUTINE BEMT_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%chord,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%chord)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%chord))-1 ) = PACK(InData%chord,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%chord) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%numBlades - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%airDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%kinVisc - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%skewWakeMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%aTol - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%useTipLoss , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%useHubLoss , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%useInduction , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%useTanInd , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%useAIDrag , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%useTIDrag , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%numBladeNodes - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%numReIterations - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%maxIndIterations - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(InData%chord,2), UBOUND(InData%chord,2) + DO i1 = LBOUND(InData%chord,1), UBOUND(InData%chord,1) + ReKiBuf(Re_Xferred) = InData%chord(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IntKiBuf(Int_Xferred) = InData%numBlades + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%airDens + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%kinVisc + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%skewWakeMod + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%aTol + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%useTipLoss, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%useHubLoss, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%useInduction, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%useTanInd, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%useAIDrag, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%useTIDrag, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%numBladeNodes + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%numReIterations + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%maxIndIterations + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%AFindx) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -490,8 +494,12 @@ SUBROUTINE BEMT_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFindx,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AFindx)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%AFindx))-1 ) = PACK(InData%AFindx,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%AFindx) + DO i2 = LBOUND(InData%AFindx,2), UBOUND(InData%AFindx,2) + DO i1 = LBOUND(InData%AFindx,1), UBOUND(InData%AFindx,1) + IntKiBuf(Int_Xferred) = InData%AFindx(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%zHub) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -503,8 +511,10 @@ SUBROUTINE BEMT_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%zHub,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%zHub)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%zHub))-1 ) = PACK(InData%zHub,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%zHub) + DO i1 = LBOUND(InData%zHub,1), UBOUND(InData%zHub,1) + ReKiBuf(Re_Xferred) = InData%zHub(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%zLocal) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -519,8 +529,12 @@ SUBROUTINE BEMT_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%zLocal,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%zLocal)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%zLocal))-1 ) = PACK(InData%zLocal,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%zLocal) + DO i2 = LBOUND(InData%zLocal,2), UBOUND(InData%zLocal,2) + DO i1 = LBOUND(InData%zLocal,1), UBOUND(InData%zLocal,1) + ReKiBuf(Re_Xferred) = InData%zLocal(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%zTip) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -532,8 +546,10 @@ SUBROUTINE BEMT_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%zTip,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%zTip)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%zTip))-1 ) = PACK(InData%zTip,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%zTip) + DO i1 = LBOUND(InData%zTip,1), UBOUND(InData%zTip,1) + ReKiBuf(Re_Xferred) = InData%zTip(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%rLocal) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -548,23 +564,27 @@ SUBROUTINE BEMT_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rLocal,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%rLocal)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%rLocal))-1 ) = PACK(InData%rLocal,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%rLocal) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UAMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%UA_Flag , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Flookup , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%a_s - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DBEMT_Mod - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%tau1_const - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%yawCorrFactor - Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(InData%rLocal,2), UBOUND(InData%rLocal,2) + DO i1 = LBOUND(InData%rLocal,1), UBOUND(InData%rLocal,1) + ReKiBuf(Re_Xferred) = InData%rLocal(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IntKiBuf(Int_Xferred) = InData%UAMod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%UA_Flag, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%Flookup, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%a_s + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DBEMT_Mod + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%tau1_const + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%yawCorrFactor + Re_Xferred = Re_Xferred + 1 END SUBROUTINE BEMT_PackInitInput SUBROUTINE BEMT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -580,12 +600,6 @@ SUBROUTINE BEMT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -617,44 +631,41 @@ SUBROUTINE BEMT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%chord.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%chord)>0) OutData%chord = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%chord))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%chord) - DEALLOCATE(mask2) - END IF - OutData%numBlades = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%airDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%kinVisc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%skewWakeMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%aTol = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%useTipLoss = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%useHubLoss = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%useInduction = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%useTanInd = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%useAIDrag = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%useTIDrag = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%numBladeNodes = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%numReIterations = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%maxIndIterations = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(OutData%chord,2), UBOUND(OutData%chord,2) + DO i1 = LBOUND(OutData%chord,1), UBOUND(OutData%chord,1) + OutData%chord(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%numBlades = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%airDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%kinVisc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%skewWakeMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%aTol = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%useTipLoss = TRANSFER(IntKiBuf(Int_Xferred), OutData%useTipLoss) + Int_Xferred = Int_Xferred + 1 + OutData%useHubLoss = TRANSFER(IntKiBuf(Int_Xferred), OutData%useHubLoss) + Int_Xferred = Int_Xferred + 1 + OutData%useInduction = TRANSFER(IntKiBuf(Int_Xferred), OutData%useInduction) + Int_Xferred = Int_Xferred + 1 + OutData%useTanInd = TRANSFER(IntKiBuf(Int_Xferred), OutData%useTanInd) + Int_Xferred = Int_Xferred + 1 + OutData%useAIDrag = TRANSFER(IntKiBuf(Int_Xferred), OutData%useAIDrag) + Int_Xferred = Int_Xferred + 1 + OutData%useTIDrag = TRANSFER(IntKiBuf(Int_Xferred), OutData%useTIDrag) + Int_Xferred = Int_Xferred + 1 + OutData%numBladeNodes = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%numReIterations = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%maxIndIterations = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AFindx not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -671,15 +682,12 @@ SUBROUTINE BEMT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFindx.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%AFindx)>0) OutData%AFindx = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%AFindx))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%AFindx) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AFindx,2), UBOUND(OutData%AFindx,2) + DO i1 = LBOUND(OutData%AFindx,1), UBOUND(OutData%AFindx,1) + OutData%AFindx(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! zHub not allocated Int_Xferred = Int_Xferred + 1 @@ -694,15 +702,10 @@ SUBROUTINE BEMT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%zHub.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%zHub)>0) OutData%zHub = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%zHub))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%zHub) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%zHub,1), UBOUND(OutData%zHub,1) + OutData%zHub(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! zLocal not allocated Int_Xferred = Int_Xferred + 1 @@ -720,15 +723,12 @@ SUBROUTINE BEMT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%zLocal.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%zLocal)>0) OutData%zLocal = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%zLocal))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%zLocal) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%zLocal,2), UBOUND(OutData%zLocal,2) + DO i1 = LBOUND(OutData%zLocal,1), UBOUND(OutData%zLocal,1) + OutData%zLocal(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! zTip not allocated Int_Xferred = Int_Xferred + 1 @@ -743,15 +743,10 @@ SUBROUTINE BEMT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%zTip.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%zTip)>0) OutData%zTip = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%zTip))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%zTip) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%zTip,1), UBOUND(OutData%zTip,1) + OutData%zTip(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rLocal not allocated Int_Xferred = Int_Xferred + 1 @@ -769,30 +764,27 @@ SUBROUTINE BEMT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rLocal.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%rLocal)>0) OutData%rLocal = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%rLocal))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%rLocal) - DEALLOCATE(mask2) - END IF - OutData%UAMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%UA_Flag = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%Flookup = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%a_s = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%DBEMT_Mod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%tau1_const = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%yawCorrFactor = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(OutData%rLocal,2), UBOUND(OutData%rLocal,2) + DO i1 = LBOUND(OutData%rLocal,1), UBOUND(OutData%rLocal,1) + OutData%rLocal(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%UAMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%UA_Flag = TRANSFER(IntKiBuf(Int_Xferred), OutData%UA_Flag) + Int_Xferred = Int_Xferred + 1 + OutData%Flookup = TRANSFER(IntKiBuf(Int_Xferred), OutData%Flookup) + Int_Xferred = Int_Xferred + 1 + OutData%a_s = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%DBEMT_Mod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%tau1_const = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%yawCorrFactor = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE BEMT_UnPackInitInput SUBROUTINE BEMT_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -949,12 +941,6 @@ SUBROUTINE BEMT_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_UnPackInitOutput' @@ -1123,8 +1109,8 @@ SUBROUTINE BEMT_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyContState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyContState + Re_Xferred = Re_Xferred + 1 CALL DBEMT_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%DBEMT, ErrStat2, ErrMsg2, OnlySize ) ! DBEMT CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1168,12 +1154,6 @@ SUBROUTINE BEMT_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_UnPackContState' @@ -1187,8 +1167,8 @@ SUBROUTINE BEMT_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyContState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyContState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -1385,12 +1365,6 @@ SUBROUTINE BEMT_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_UnPackDiscState' @@ -1572,8 +1546,12 @@ SUBROUTINE BEMT_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%phi,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%phi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%phi))-1 ) = PACK(InData%phi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%phi) + DO i2 = LBOUND(InData%phi,2), UBOUND(InData%phi,2) + DO i1 = LBOUND(InData%phi,1), UBOUND(InData%phi,1) + ReKiBuf(Re_Xferred) = InData%phi(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE BEMT_PackConstrState @@ -1590,12 +1568,6 @@ SUBROUTINE BEMT_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -1627,15 +1599,12 @@ SUBROUTINE BEMT_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%phi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%phi)>0) OutData%phi = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%phi))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%phi) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%phi,2), UBOUND(OutData%phi,2) + DO i1 = LBOUND(OutData%phi,1), UBOUND(OutData%phi,1) + OutData%phi(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE BEMT_UnPackConstrState @@ -1888,8 +1857,12 @@ SUBROUTINE BEMT_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UA_Flag,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%UA_Flag)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%UA_Flag)-1 ) = TRANSFER(PACK( InData%UA_Flag ,.TRUE.), IntKiBuf(1), SIZE(InData%UA_Flag)) - Int_Xferred = Int_Xferred + SIZE(InData%UA_Flag) + DO i2 = LBOUND(InData%UA_Flag,2), UBOUND(InData%UA_Flag,2) + DO i1 = LBOUND(InData%UA_Flag,1), UBOUND(InData%UA_Flag,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%UA_Flag(i1,i2), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%ValidPhi) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1904,11 +1877,15 @@ SUBROUTINE BEMT_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ValidPhi,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ValidPhi)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%ValidPhi)-1 ) = TRANSFER(PACK( InData%ValidPhi ,.TRUE.), IntKiBuf(1), SIZE(InData%ValidPhi)) - Int_Xferred = Int_Xferred + SIZE(InData%ValidPhi) + DO i2 = LBOUND(InData%ValidPhi,2), UBOUND(InData%ValidPhi,2) + DO i1 = LBOUND(InData%ValidPhi,1), UBOUND(InData%ValidPhi,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%ValidPhi(i1,i2), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%nodesInitialized , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%nodesInitialized, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE BEMT_PackOtherState SUBROUTINE BEMT_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1924,12 +1901,6 @@ SUBROUTINE BEMT_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -2041,15 +2012,12 @@ SUBROUTINE BEMT_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UA_Flag.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%UA_Flag)>0) OutData%UA_Flag = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%UA_Flag))-1 ), OutData%UA_Flag), mask2,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%UA_Flag) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%UA_Flag,2), UBOUND(OutData%UA_Flag,2) + DO i1 = LBOUND(OutData%UA_Flag,1), UBOUND(OutData%UA_Flag,1) + OutData%UA_Flag(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%UA_Flag(i1,i2)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ValidPhi not allocated Int_Xferred = Int_Xferred + 1 @@ -2067,18 +2035,15 @@ SUBROUTINE BEMT_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ValidPhi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%ValidPhi)>0) OutData%ValidPhi = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%ValidPhi))-1 ), OutData%ValidPhi), mask2,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%ValidPhi) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%ValidPhi,2), UBOUND(OutData%ValidPhi,2) + DO i1 = LBOUND(OutData%ValidPhi,1), UBOUND(OutData%ValidPhi,1) + OutData%ValidPhi(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%ValidPhi(i1,i2)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF - OutData%nodesInitialized = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%nodesInitialized = TRANSFER(IntKiBuf(Int_Xferred), OutData%nodesInitialized) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE BEMT_UnPackOtherState SUBROUTINE BEMT_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) @@ -2350,10 +2315,10 @@ SUBROUTINE BEMT_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%FirstWarn_Skew , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%FirstWarn_Phi , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%FirstWarn_Skew, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%FirstWarn_Phi, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 CALL UA_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%UA, ErrStat2, ErrMsg2, OnlySize ) ! UA CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2451,8 +2416,12 @@ SUBROUTINE BEMT_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TnInd_op,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TnInd_op)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TnInd_op))-1 ) = PACK(InData%TnInd_op,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TnInd_op) + DO i2 = LBOUND(InData%TnInd_op,2), UBOUND(InData%TnInd_op,2) + DO i1 = LBOUND(InData%TnInd_op,1), UBOUND(InData%TnInd_op,1) + ReKiBuf(Re_Xferred) = InData%TnInd_op(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%AxInd_op) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2467,8 +2436,12 @@ SUBROUTINE BEMT_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxInd_op,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AxInd_op)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AxInd_op))-1 ) = PACK(InData%AxInd_op,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AxInd_op) + DO i2 = LBOUND(InData%AxInd_op,2), UBOUND(InData%AxInd_op,2) + DO i1 = LBOUND(InData%AxInd_op,1), UBOUND(InData%AxInd_op,1) + ReKiBuf(Re_Xferred) = InData%AxInd_op(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%AxInduction) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2483,8 +2456,12 @@ SUBROUTINE BEMT_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxInduction,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AxInduction)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AxInduction))-1 ) = PACK(InData%AxInduction,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AxInduction) + DO i2 = LBOUND(InData%AxInduction,2), UBOUND(InData%AxInduction,2) + DO i1 = LBOUND(InData%AxInduction,1), UBOUND(InData%AxInduction,1) + ReKiBuf(Re_Xferred) = InData%AxInduction(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%TanInduction) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2499,11 +2476,15 @@ SUBROUTINE BEMT_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TanInduction,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TanInduction)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TanInduction))-1 ) = PACK(InData%TanInduction,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TanInduction) + DO i2 = LBOUND(InData%TanInduction,2), UBOUND(InData%TanInduction,2) + DO i1 = LBOUND(InData%TanInduction,1), UBOUND(InData%TanInduction,1) + ReKiBuf(Re_Xferred) = InData%TanInduction(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%UseFrozenWake , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%UseFrozenWake, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%Rtip) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2514,8 +2495,10 @@ SUBROUTINE BEMT_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Rtip,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Rtip)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Rtip))-1 ) = PACK(InData%Rtip,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Rtip) + DO i1 = LBOUND(InData%Rtip,1), UBOUND(InData%Rtip,1) + ReKiBuf(Re_Xferred) = InData%Rtip(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE BEMT_PackMisc @@ -2532,12 +2515,6 @@ SUBROUTINE BEMT_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -2553,10 +2530,10 @@ SUBROUTINE BEMT_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%FirstWarn_Skew = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%FirstWarn_Phi = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%FirstWarn_Skew = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstWarn_Skew) + Int_Xferred = Int_Xferred + 1 + OutData%FirstWarn_Phi = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstWarn_Phi) + Int_Xferred = Int_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -2693,15 +2670,12 @@ SUBROUTINE BEMT_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TnInd_op.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%TnInd_op)>0) OutData%TnInd_op = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TnInd_op))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TnInd_op) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%TnInd_op,2), UBOUND(OutData%TnInd_op,2) + DO i1 = LBOUND(OutData%TnInd_op,1), UBOUND(OutData%TnInd_op,1) + OutData%TnInd_op(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AxInd_op not allocated Int_Xferred = Int_Xferred + 1 @@ -2719,15 +2693,12 @@ SUBROUTINE BEMT_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AxInd_op.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%AxInd_op)>0) OutData%AxInd_op = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AxInd_op))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AxInd_op) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AxInd_op,2), UBOUND(OutData%AxInd_op,2) + DO i1 = LBOUND(OutData%AxInd_op,1), UBOUND(OutData%AxInd_op,1) + OutData%AxInd_op(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AxInduction not allocated Int_Xferred = Int_Xferred + 1 @@ -2745,15 +2716,12 @@ SUBROUTINE BEMT_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AxInduction.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%AxInduction)>0) OutData%AxInduction = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AxInduction))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AxInduction) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AxInduction,2), UBOUND(OutData%AxInduction,2) + DO i1 = LBOUND(OutData%AxInduction,1), UBOUND(OutData%AxInduction,1) + OutData%AxInduction(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TanInduction not allocated Int_Xferred = Int_Xferred + 1 @@ -2771,18 +2739,15 @@ SUBROUTINE BEMT_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TanInduction.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%TanInduction)>0) OutData%TanInduction = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TanInduction))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TanInduction) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%TanInduction,2), UBOUND(OutData%TanInduction,2) + DO i1 = LBOUND(OutData%TanInduction,1), UBOUND(OutData%TanInduction,1) + OutData%TanInduction(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - OutData%UseFrozenWake = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%UseFrozenWake = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseFrozenWake) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Rtip not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -2796,15 +2761,10 @@ SUBROUTINE BEMT_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Rtip.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Rtip)>0) OutData%Rtip = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Rtip))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Rtip) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Rtip,1), UBOUND(OutData%Rtip,1) + OutData%Rtip(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE BEMT_UnPackMisc @@ -3086,8 +3046,8 @@ SUBROUTINE BEMT_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 IF ( .NOT. ALLOCATED(InData%chord) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -3101,37 +3061,41 @@ SUBROUTINE BEMT_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%chord,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%chord)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%chord))-1 ) = PACK(InData%chord,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%chord) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%numBlades - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%airDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%kinVisc - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%skewWakeMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%aTol - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%useTipLoss , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%useHubLoss , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%useInduction , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%useTanInd , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%useAIDrag , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%useTIDrag , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%numBladeNodes - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%numReIterations - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%maxIndIterations - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(InData%chord,2), UBOUND(InData%chord,2) + DO i1 = LBOUND(InData%chord,1), UBOUND(InData%chord,1) + ReKiBuf(Re_Xferred) = InData%chord(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IntKiBuf(Int_Xferred) = InData%numBlades + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%airDens + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%kinVisc + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%skewWakeMod + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%aTol + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%useTipLoss, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%useHubLoss, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%useInduction, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%useTanInd, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%useAIDrag, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%useTIDrag, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%numBladeNodes + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%numReIterations + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%maxIndIterations + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%AFindx) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -3145,8 +3109,12 @@ SUBROUTINE BEMT_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFindx,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AFindx)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%AFindx))-1 ) = PACK(InData%AFindx,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%AFindx) + DO i2 = LBOUND(InData%AFindx,2), UBOUND(InData%AFindx,2) + DO i1 = LBOUND(InData%AFindx,1), UBOUND(InData%AFindx,1) + IntKiBuf(Int_Xferred) = InData%AFindx(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%tipLossConst) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3161,8 +3129,12 @@ SUBROUTINE BEMT_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%tipLossConst,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%tipLossConst)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%tipLossConst))-1 ) = PACK(InData%tipLossConst,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%tipLossConst) + DO i2 = LBOUND(InData%tipLossConst,2), UBOUND(InData%tipLossConst,2) + DO i1 = LBOUND(InData%tipLossConst,1), UBOUND(InData%tipLossConst,1) + ReKiBuf(Re_Xferred) = InData%tipLossConst(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%hubLossConst) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3177,8 +3149,12 @@ SUBROUTINE BEMT_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%hubLossConst,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%hubLossConst)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%hubLossConst))-1 ) = PACK(InData%hubLossConst,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%hubLossConst) + DO i2 = LBOUND(InData%hubLossConst,2), UBOUND(InData%hubLossConst,2) + DO i1 = LBOUND(InData%hubLossConst,1), UBOUND(InData%hubLossConst,1) + ReKiBuf(Re_Xferred) = InData%hubLossConst(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%zHub) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3190,8 +3166,10 @@ SUBROUTINE BEMT_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%zHub,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%zHub)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%zHub))-1 ) = PACK(InData%zHub,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%zHub) + DO i1 = LBOUND(InData%zHub,1), UBOUND(InData%zHub,1) + ReKiBuf(Re_Xferred) = InData%zHub(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF CALL UA_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%UA, ErrStat2, ErrMsg2, OnlySize ) ! UA CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3249,12 +3227,12 @@ SUBROUTINE BEMT_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%UA_Flag , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DBEMT_Mod - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%yawCorrFactor - Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%UA_Flag, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DBEMT_Mod + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%yawCorrFactor + Re_Xferred = Re_Xferred + 1 END SUBROUTINE BEMT_PackParam SUBROUTINE BEMT_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -3270,12 +3248,6 @@ SUBROUTINE BEMT_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -3291,8 +3263,8 @@ SUBROUTINE BEMT_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! chord not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3309,44 +3281,41 @@ SUBROUTINE BEMT_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%chord.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%chord)>0) OutData%chord = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%chord))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%chord) - DEALLOCATE(mask2) - END IF - OutData%numBlades = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%airDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%kinVisc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%skewWakeMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%aTol = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%useTipLoss = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%useHubLoss = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%useInduction = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%useTanInd = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%useAIDrag = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%useTIDrag = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%numBladeNodes = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%numReIterations = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%maxIndIterations = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(OutData%chord,2), UBOUND(OutData%chord,2) + DO i1 = LBOUND(OutData%chord,1), UBOUND(OutData%chord,1) + OutData%chord(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%numBlades = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%airDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%kinVisc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%skewWakeMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%aTol = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%useTipLoss = TRANSFER(IntKiBuf(Int_Xferred), OutData%useTipLoss) + Int_Xferred = Int_Xferred + 1 + OutData%useHubLoss = TRANSFER(IntKiBuf(Int_Xferred), OutData%useHubLoss) + Int_Xferred = Int_Xferred + 1 + OutData%useInduction = TRANSFER(IntKiBuf(Int_Xferred), OutData%useInduction) + Int_Xferred = Int_Xferred + 1 + OutData%useTanInd = TRANSFER(IntKiBuf(Int_Xferred), OutData%useTanInd) + Int_Xferred = Int_Xferred + 1 + OutData%useAIDrag = TRANSFER(IntKiBuf(Int_Xferred), OutData%useAIDrag) + Int_Xferred = Int_Xferred + 1 + OutData%useTIDrag = TRANSFER(IntKiBuf(Int_Xferred), OutData%useTIDrag) + Int_Xferred = Int_Xferred + 1 + OutData%numBladeNodes = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%numReIterations = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%maxIndIterations = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AFindx not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3363,15 +3332,12 @@ SUBROUTINE BEMT_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFindx.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%AFindx)>0) OutData%AFindx = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%AFindx))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%AFindx) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AFindx,2), UBOUND(OutData%AFindx,2) + DO i1 = LBOUND(OutData%AFindx,1), UBOUND(OutData%AFindx,1) + OutData%AFindx(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! tipLossConst not allocated Int_Xferred = Int_Xferred + 1 @@ -3389,15 +3355,12 @@ SUBROUTINE BEMT_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%tipLossConst.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%tipLossConst)>0) OutData%tipLossConst = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%tipLossConst))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%tipLossConst) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%tipLossConst,2), UBOUND(OutData%tipLossConst,2) + DO i1 = LBOUND(OutData%tipLossConst,1), UBOUND(OutData%tipLossConst,1) + OutData%tipLossConst(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! hubLossConst not allocated Int_Xferred = Int_Xferred + 1 @@ -3415,15 +3378,12 @@ SUBROUTINE BEMT_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%hubLossConst.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%hubLossConst)>0) OutData%hubLossConst = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%hubLossConst))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%hubLossConst) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%hubLossConst,2), UBOUND(OutData%hubLossConst,2) + DO i1 = LBOUND(OutData%hubLossConst,1), UBOUND(OutData%hubLossConst,1) + OutData%hubLossConst(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! zHub not allocated Int_Xferred = Int_Xferred + 1 @@ -3438,15 +3398,10 @@ SUBROUTINE BEMT_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%zHub.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%zHub)>0) OutData%zHub = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%zHub))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%zHub) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%zHub,1), UBOUND(OutData%zHub,1) + OutData%zHub(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -3528,12 +3483,12 @@ SUBROUTINE BEMT_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%UA_Flag = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%DBEMT_Mod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%yawCorrFactor = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%UA_Flag = TRANSFER(IntKiBuf(Int_Xferred), OutData%UA_Flag) + Int_Xferred = Int_Xferred + 1 + OutData%DBEMT_Mod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%yawCorrFactor = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE BEMT_UnPackParam SUBROUTINE BEMT_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -3776,11 +3731,15 @@ SUBROUTINE BEMT_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%theta,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%theta)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%theta))-1 ) = PACK(InData%theta,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%theta) + DO i2 = LBOUND(InData%theta,2), UBOUND(InData%theta,2) + DO i1 = LBOUND(InData%theta,1), UBOUND(InData%theta,1) + ReKiBuf(Re_Xferred) = InData%theta(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%chi0 - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%chi0 + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%psi) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -3791,11 +3750,13 @@ SUBROUTINE BEMT_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%psi,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%psi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%psi))-1 ) = PACK(InData%psi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%psi) + DO i1 = LBOUND(InData%psi,1), UBOUND(InData%psi,1) + ReKiBuf(Re_Xferred) = InData%psi(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%omega - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%omega + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%Vx) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -3809,8 +3770,12 @@ SUBROUTINE BEMT_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vx,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Vx)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Vx))-1 ) = PACK(InData%Vx,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Vx) + DO i2 = LBOUND(InData%Vx,2), UBOUND(InData%Vx,2) + DO i1 = LBOUND(InData%Vx,1), UBOUND(InData%Vx,1) + ReKiBuf(Re_Xferred) = InData%Vx(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Vy) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3825,8 +3790,12 @@ SUBROUTINE BEMT_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vy,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Vy)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Vy))-1 ) = PACK(InData%Vy,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Vy) + DO i2 = LBOUND(InData%Vy,2), UBOUND(InData%Vy,2) + DO i1 = LBOUND(InData%Vy,1), UBOUND(InData%Vy,1) + ReKiBuf(Re_Xferred) = InData%Vy(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%rLocal) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3841,11 +3810,15 @@ SUBROUTINE BEMT_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rLocal,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%rLocal)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%rLocal))-1 ) = PACK(InData%rLocal,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%rLocal) + DO i2 = LBOUND(InData%rLocal,2), UBOUND(InData%rLocal,2) + DO i1 = LBOUND(InData%rLocal,1), UBOUND(InData%rLocal,1) + ReKiBuf(Re_Xferred) = InData%rLocal(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Un_disk - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Un_disk + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%UserProp) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -3859,8 +3832,12 @@ SUBROUTINE BEMT_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UserProp,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%UserProp)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%UserProp))-1 ) = PACK(InData%UserProp,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%UserProp) + DO i2 = LBOUND(InData%UserProp,2), UBOUND(InData%UserProp,2) + DO i1 = LBOUND(InData%UserProp,1), UBOUND(InData%UserProp,1) + ReKiBuf(Re_Xferred) = InData%UserProp(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE BEMT_PackInput @@ -3877,12 +3854,6 @@ SUBROUTINE BEMT_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -3914,18 +3885,15 @@ SUBROUTINE BEMT_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%theta.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%theta)>0) OutData%theta = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%theta))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%theta) - DEALLOCATE(mask2) - END IF - OutData%chi0 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(OutData%theta,2), UBOUND(OutData%theta,2) + DO i1 = LBOUND(OutData%theta,1), UBOUND(OutData%theta,1) + OutData%theta(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%chi0 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! psi not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3939,18 +3907,13 @@ SUBROUTINE BEMT_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%psi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%psi)>0) OutData%psi = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%psi))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%psi) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%psi,1), UBOUND(OutData%psi,1) + OutData%psi(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%omega = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%omega = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vx not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3967,15 +3930,12 @@ SUBROUTINE BEMT_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vx.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Vx)>0) OutData%Vx = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Vx))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Vx) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Vx,2), UBOUND(OutData%Vx,2) + DO i1 = LBOUND(OutData%Vx,1), UBOUND(OutData%Vx,1) + OutData%Vx(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Vy not allocated Int_Xferred = Int_Xferred + 1 @@ -3993,15 +3953,12 @@ SUBROUTINE BEMT_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vy.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Vy)>0) OutData%Vy = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Vy))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Vy) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Vy,2), UBOUND(OutData%Vy,2) + DO i1 = LBOUND(OutData%Vy,1), UBOUND(OutData%Vy,1) + OutData%Vy(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rLocal not allocated Int_Xferred = Int_Xferred + 1 @@ -4019,18 +3976,15 @@ SUBROUTINE BEMT_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rLocal.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%rLocal)>0) OutData%rLocal = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%rLocal))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%rLocal) - DEALLOCATE(mask2) - END IF - OutData%Un_disk = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(OutData%rLocal,2), UBOUND(OutData%rLocal,2) + DO i1 = LBOUND(OutData%rLocal,1), UBOUND(OutData%rLocal,1) + OutData%rLocal(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%Un_disk = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UserProp not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -4047,15 +4001,12 @@ SUBROUTINE BEMT_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UserProp.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%UserProp)>0) OutData%UserProp = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%UserProp))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%UserProp) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%UserProp,2), UBOUND(OutData%UserProp,2) + DO i1 = LBOUND(OutData%UserProp,1), UBOUND(OutData%UserProp,1) + OutData%UserProp(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE BEMT_UnPackInput @@ -4449,8 +4400,12 @@ SUBROUTINE BEMT_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Vrel,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Vrel)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Vrel))-1 ) = PACK(InData%Vrel,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Vrel) + DO i2 = LBOUND(InData%Vrel,2), UBOUND(InData%Vrel,2) + DO i1 = LBOUND(InData%Vrel,1), UBOUND(InData%Vrel,1) + ReKiBuf(Re_Xferred) = InData%Vrel(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%phi) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4465,8 +4420,12 @@ SUBROUTINE BEMT_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%phi,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%phi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%phi))-1 ) = PACK(InData%phi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%phi) + DO i2 = LBOUND(InData%phi,2), UBOUND(InData%phi,2) + DO i1 = LBOUND(InData%phi,1), UBOUND(InData%phi,1) + ReKiBuf(Re_Xferred) = InData%phi(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%axInduction) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4481,8 +4440,12 @@ SUBROUTINE BEMT_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%axInduction,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%axInduction)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%axInduction))-1 ) = PACK(InData%axInduction,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%axInduction) + DO i2 = LBOUND(InData%axInduction,2), UBOUND(InData%axInduction,2) + DO i1 = LBOUND(InData%axInduction,1), UBOUND(InData%axInduction,1) + ReKiBuf(Re_Xferred) = InData%axInduction(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%tanInduction) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4497,8 +4460,12 @@ SUBROUTINE BEMT_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%tanInduction,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%tanInduction)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%tanInduction))-1 ) = PACK(InData%tanInduction,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%tanInduction) + DO i2 = LBOUND(InData%tanInduction,2), UBOUND(InData%tanInduction,2) + DO i1 = LBOUND(InData%tanInduction,1), UBOUND(InData%tanInduction,1) + ReKiBuf(Re_Xferred) = InData%tanInduction(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Re) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4513,8 +4480,12 @@ SUBROUTINE BEMT_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Re,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Re)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Re))-1 ) = PACK(InData%Re,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Re) + DO i2 = LBOUND(InData%Re,2), UBOUND(InData%Re,2) + DO i1 = LBOUND(InData%Re,1), UBOUND(InData%Re,1) + ReKiBuf(Re_Xferred) = InData%Re(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%AOA) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4529,8 +4500,12 @@ SUBROUTINE BEMT_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AOA,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AOA)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AOA))-1 ) = PACK(InData%AOA,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AOA) + DO i2 = LBOUND(InData%AOA,2), UBOUND(InData%AOA,2) + DO i1 = LBOUND(InData%AOA,1), UBOUND(InData%AOA,1) + ReKiBuf(Re_Xferred) = InData%AOA(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Cx) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4545,8 +4520,12 @@ SUBROUTINE BEMT_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cx,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Cx)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Cx))-1 ) = PACK(InData%Cx,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Cx) + DO i2 = LBOUND(InData%Cx,2), UBOUND(InData%Cx,2) + DO i1 = LBOUND(InData%Cx,1), UBOUND(InData%Cx,1) + ReKiBuf(Re_Xferred) = InData%Cx(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Cy) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4561,8 +4540,12 @@ SUBROUTINE BEMT_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cy,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Cy)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Cy))-1 ) = PACK(InData%Cy,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Cy) + DO i2 = LBOUND(InData%Cy,2), UBOUND(InData%Cy,2) + DO i1 = LBOUND(InData%Cy,1), UBOUND(InData%Cy,1) + ReKiBuf(Re_Xferred) = InData%Cy(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Cm) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4577,8 +4560,12 @@ SUBROUTINE BEMT_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cm,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Cm)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Cm))-1 ) = PACK(InData%Cm,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Cm) + DO i2 = LBOUND(InData%Cm,2), UBOUND(InData%Cm,2) + DO i1 = LBOUND(InData%Cm,1), UBOUND(InData%Cm,1) + ReKiBuf(Re_Xferred) = InData%Cm(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Cl) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4593,8 +4580,12 @@ SUBROUTINE BEMT_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cl,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Cl)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Cl))-1 ) = PACK(InData%Cl,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Cl) + DO i2 = LBOUND(InData%Cl,2), UBOUND(InData%Cl,2) + DO i1 = LBOUND(InData%Cl,1), UBOUND(InData%Cl,1) + ReKiBuf(Re_Xferred) = InData%Cl(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Cd) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4609,8 +4600,12 @@ SUBROUTINE BEMT_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cd,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Cd)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Cd))-1 ) = PACK(InData%Cd,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Cd) + DO i2 = LBOUND(InData%Cd,2), UBOUND(InData%Cd,2) + DO i1 = LBOUND(InData%Cd,1), UBOUND(InData%Cd,1) + ReKiBuf(Re_Xferred) = InData%Cd(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%chi) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4625,8 +4620,12 @@ SUBROUTINE BEMT_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%chi,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%chi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%chi))-1 ) = PACK(InData%chi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%chi) + DO i2 = LBOUND(InData%chi,2), UBOUND(InData%chi,2) + DO i1 = LBOUND(InData%chi,1), UBOUND(InData%chi,1) + ReKiBuf(Re_Xferred) = InData%chi(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Cpmin) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4641,8 +4640,12 @@ SUBROUTINE BEMT_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cpmin,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Cpmin)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Cpmin))-1 ) = PACK(InData%Cpmin,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Cpmin) + DO i2 = LBOUND(InData%Cpmin,2), UBOUND(InData%Cpmin,2) + DO i1 = LBOUND(InData%Cpmin,1), UBOUND(InData%Cpmin,1) + ReKiBuf(Re_Xferred) = InData%Cpmin(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE BEMT_PackOutput @@ -4659,12 +4662,6 @@ SUBROUTINE BEMT_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -4696,15 +4693,12 @@ SUBROUTINE BEMT_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Vrel.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Vrel)>0) OutData%Vrel = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Vrel))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Vrel) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Vrel,2), UBOUND(OutData%Vrel,2) + DO i1 = LBOUND(OutData%Vrel,1), UBOUND(OutData%Vrel,1) + OutData%Vrel(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! phi not allocated Int_Xferred = Int_Xferred + 1 @@ -4722,15 +4716,12 @@ SUBROUTINE BEMT_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%phi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%phi)>0) OutData%phi = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%phi))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%phi) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%phi,2), UBOUND(OutData%phi,2) + DO i1 = LBOUND(OutData%phi,1), UBOUND(OutData%phi,1) + OutData%phi(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! axInduction not allocated Int_Xferred = Int_Xferred + 1 @@ -4748,15 +4739,12 @@ SUBROUTINE BEMT_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%axInduction.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%axInduction)>0) OutData%axInduction = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%axInduction))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%axInduction) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%axInduction,2), UBOUND(OutData%axInduction,2) + DO i1 = LBOUND(OutData%axInduction,1), UBOUND(OutData%axInduction,1) + OutData%axInduction(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! tanInduction not allocated Int_Xferred = Int_Xferred + 1 @@ -4774,15 +4762,12 @@ SUBROUTINE BEMT_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%tanInduction.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%tanInduction)>0) OutData%tanInduction = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%tanInduction))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%tanInduction) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%tanInduction,2), UBOUND(OutData%tanInduction,2) + DO i1 = LBOUND(OutData%tanInduction,1), UBOUND(OutData%tanInduction,1) + OutData%tanInduction(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Re not allocated Int_Xferred = Int_Xferred + 1 @@ -4800,15 +4785,12 @@ SUBROUTINE BEMT_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Re.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Re)>0) OutData%Re = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Re))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Re) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Re,2), UBOUND(OutData%Re,2) + DO i1 = LBOUND(OutData%Re,1), UBOUND(OutData%Re,1) + OutData%Re(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AOA not allocated Int_Xferred = Int_Xferred + 1 @@ -4826,15 +4808,12 @@ SUBROUTINE BEMT_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AOA.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%AOA)>0) OutData%AOA = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AOA))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AOA) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AOA,2), UBOUND(OutData%AOA,2) + DO i1 = LBOUND(OutData%AOA,1), UBOUND(OutData%AOA,1) + OutData%AOA(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cx not allocated Int_Xferred = Int_Xferred + 1 @@ -4852,15 +4831,12 @@ SUBROUTINE BEMT_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cx.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Cx)>0) OutData%Cx = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Cx))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Cx) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Cx,2), UBOUND(OutData%Cx,2) + DO i1 = LBOUND(OutData%Cx,1), UBOUND(OutData%Cx,1) + OutData%Cx(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cy not allocated Int_Xferred = Int_Xferred + 1 @@ -4878,15 +4854,12 @@ SUBROUTINE BEMT_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cy.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Cy)>0) OutData%Cy = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Cy))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Cy) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Cy,2), UBOUND(OutData%Cy,2) + DO i1 = LBOUND(OutData%Cy,1), UBOUND(OutData%Cy,1) + OutData%Cy(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cm not allocated Int_Xferred = Int_Xferred + 1 @@ -4904,15 +4877,12 @@ SUBROUTINE BEMT_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cm.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Cm)>0) OutData%Cm = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Cm))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Cm) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Cm,2), UBOUND(OutData%Cm,2) + DO i1 = LBOUND(OutData%Cm,1), UBOUND(OutData%Cm,1) + OutData%Cm(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cl not allocated Int_Xferred = Int_Xferred + 1 @@ -4930,15 +4900,12 @@ SUBROUTINE BEMT_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cl.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Cl)>0) OutData%Cl = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Cl))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Cl) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Cl,2), UBOUND(OutData%Cl,2) + DO i1 = LBOUND(OutData%Cl,1), UBOUND(OutData%Cl,1) + OutData%Cl(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cd not allocated Int_Xferred = Int_Xferred + 1 @@ -4956,15 +4923,12 @@ SUBROUTINE BEMT_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cd.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Cd)>0) OutData%Cd = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Cd))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Cd) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Cd,2), UBOUND(OutData%Cd,2) + DO i1 = LBOUND(OutData%Cd,1), UBOUND(OutData%Cd,1) + OutData%Cd(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! chi not allocated Int_Xferred = Int_Xferred + 1 @@ -4982,15 +4946,12 @@ SUBROUTINE BEMT_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%chi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%chi)>0) OutData%chi = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%chi))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%chi) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%chi,2), UBOUND(OutData%chi,2) + DO i1 = LBOUND(OutData%chi,1), UBOUND(OutData%chi,1) + OutData%chi(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cpmin not allocated Int_Xferred = Int_Xferred + 1 @@ -5008,15 +4969,12 @@ SUBROUTINE BEMT_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cpmin.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Cpmin)>0) OutData%Cpmin = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Cpmin))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Cpmin) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Cpmin,2), UBOUND(OutData%Cpmin,2) + DO i1 = LBOUND(OutData%Cpmin,1), UBOUND(OutData%Cpmin,1) + OutData%Cpmin(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE BEMT_UnPackOutput @@ -5095,14 +5053,14 @@ SUBROUTINE BEMT_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -5115,59 +5073,59 @@ SUBROUTINE BEMT_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) IF (ALLOCATED(u_out%theta) .AND. ALLOCATED(u1%theta)) THEN - ALLOCATE(b2(SIZE(u_out%theta,1),SIZE(u_out%theta,2) )) - ALLOCATE(c2(SIZE(u_out%theta,1),SIZE(u_out%theta,2) )) - b2 = -(u1%theta - u2%theta)/t(2) - u_out%theta = u1%theta + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%theta,2),UBOUND(u_out%theta,2) + DO i1 = LBOUND(u_out%theta,1),UBOUND(u_out%theta,1) + b = -(u1%theta(i1,i2) - u2%theta(i1,i2)) + u_out%theta(i1,i2) = u1%theta(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated - b0 = -(u1%chi0 - u2%chi0)/t(2) - u_out%chi0 = u1%chi0 + b0 * t_out + b = -(u1%chi0 - u2%chi0) + u_out%chi0 = u1%chi0 + b * ScaleFactor IF (ALLOCATED(u_out%psi) .AND. ALLOCATED(u1%psi)) THEN - ALLOCATE(b1(SIZE(u_out%psi,1))) - ALLOCATE(c1(SIZE(u_out%psi,1))) - b1 = -(u1%psi - u2%psi)/t(2) - u_out%psi = u1%psi + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%psi,1),UBOUND(u_out%psi,1) + b = -(u1%psi(i1) - u2%psi(i1)) + u_out%psi(i1) = u1%psi(i1) + b * ScaleFactor + END DO END IF ! check if allocated - b0 = -(u1%omega - u2%omega)/t(2) - u_out%omega = u1%omega + b0 * t_out + b = -(u1%omega - u2%omega) + u_out%omega = u1%omega + b * ScaleFactor IF (ALLOCATED(u_out%Vx) .AND. ALLOCATED(u1%Vx)) THEN - ALLOCATE(b2(SIZE(u_out%Vx,1),SIZE(u_out%Vx,2) )) - ALLOCATE(c2(SIZE(u_out%Vx,1),SIZE(u_out%Vx,2) )) - b2 = -(u1%Vx - u2%Vx)/t(2) - u_out%Vx = u1%Vx + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%Vx,2),UBOUND(u_out%Vx,2) + DO i1 = LBOUND(u_out%Vx,1),UBOUND(u_out%Vx,1) + b = -(u1%Vx(i1,i2) - u2%Vx(i1,i2)) + u_out%Vx(i1,i2) = u1%Vx(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated IF (ALLOCATED(u_out%Vy) .AND. ALLOCATED(u1%Vy)) THEN - ALLOCATE(b2(SIZE(u_out%Vy,1),SIZE(u_out%Vy,2) )) - ALLOCATE(c2(SIZE(u_out%Vy,1),SIZE(u_out%Vy,2) )) - b2 = -(u1%Vy - u2%Vy)/t(2) - u_out%Vy = u1%Vy + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%Vy,2),UBOUND(u_out%Vy,2) + DO i1 = LBOUND(u_out%Vy,1),UBOUND(u_out%Vy,1) + b = -(u1%Vy(i1,i2) - u2%Vy(i1,i2)) + u_out%Vy(i1,i2) = u1%Vy(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated IF (ALLOCATED(u_out%rLocal) .AND. ALLOCATED(u1%rLocal)) THEN - ALLOCATE(b2(SIZE(u_out%rLocal,1),SIZE(u_out%rLocal,2) )) - ALLOCATE(c2(SIZE(u_out%rLocal,1),SIZE(u_out%rLocal,2) )) - b2 = -(u1%rLocal - u2%rLocal)/t(2) - u_out%rLocal = u1%rLocal + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%rLocal,2),UBOUND(u_out%rLocal,2) + DO i1 = LBOUND(u_out%rLocal,1),UBOUND(u_out%rLocal,1) + b = -(u1%rLocal(i1,i2) - u2%rLocal(i1,i2)) + u_out%rLocal(i1,i2) = u1%rLocal(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated - b0 = -(u1%Un_disk - u2%Un_disk)/t(2) - u_out%Un_disk = u1%Un_disk + b0 * t_out + b = -(u1%Un_disk - u2%Un_disk) + u_out%Un_disk = u1%Un_disk + b * ScaleFactor IF (ALLOCATED(u_out%UserProp) .AND. ALLOCATED(u1%UserProp)) THEN - ALLOCATE(b2(SIZE(u_out%UserProp,1),SIZE(u_out%UserProp,2) )) - ALLOCATE(c2(SIZE(u_out%UserProp,1),SIZE(u_out%UserProp,2) )) - b2 = -(u1%UserProp - u2%UserProp)/t(2) - u_out%UserProp = u1%UserProp + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%UserProp,2),UBOUND(u_out%UserProp,2) + DO i1 = LBOUND(u_out%UserProp,1),UBOUND(u_out%UserProp,1) + b = -(u1%UserProp(i1,i2) - u2%UserProp(i1,i2)) + u_out%UserProp(i1,i2) = u1%UserProp(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated END SUBROUTINE BEMT_Input_ExtrapInterp1 @@ -5198,15 +5156,16 @@ SUBROUTINE BEMT_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -5225,68 +5184,68 @@ SUBROUTINE BEMT_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) IF (ALLOCATED(u_out%theta) .AND. ALLOCATED(u1%theta)) THEN - ALLOCATE(b2(SIZE(u_out%theta,1),SIZE(u_out%theta,2) )) - ALLOCATE(c2(SIZE(u_out%theta,1),SIZE(u_out%theta,2) )) - b2 = (t(3)**2*(u1%theta - u2%theta) + t(2)**2*(-u1%theta + u3%theta))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%theta + t(3)*u2%theta - t(2)*u3%theta ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%theta = u1%theta + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%theta,2),UBOUND(u_out%theta,2) + DO i1 = LBOUND(u_out%theta,1),UBOUND(u_out%theta,1) + b = (t(3)**2*(u1%theta(i1,i2) - u2%theta(i1,i2)) + t(2)**2*(-u1%theta(i1,i2) + u3%theta(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%theta(i1,i2) + t(3)*u2%theta(i1,i2) - t(2)*u3%theta(i1,i2) ) * scaleFactor + u_out%theta(i1,i2) = u1%theta(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated - b0 = (t(3)**2*(u1%chi0 - u2%chi0) + t(2)**2*(-u1%chi0 + u3%chi0))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%chi0 + t(3)*u2%chi0 - t(2)*u3%chi0 ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%chi0 = u1%chi0 + b0 * t_out + c0 * t_out**2 + b = (t(3)**2*(u1%chi0 - u2%chi0) + t(2)**2*(-u1%chi0 + u3%chi0))* scaleFactor + c = ( (t(2)-t(3))*u1%chi0 + t(3)*u2%chi0 - t(2)*u3%chi0 ) * scaleFactor + u_out%chi0 = u1%chi0 + b + c * t_out IF (ALLOCATED(u_out%psi) .AND. ALLOCATED(u1%psi)) THEN - ALLOCATE(b1(SIZE(u_out%psi,1))) - ALLOCATE(c1(SIZE(u_out%psi,1))) - b1 = (t(3)**2*(u1%psi - u2%psi) + t(2)**2*(-u1%psi + u3%psi))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%psi + t(3)*u2%psi - t(2)*u3%psi ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%psi = u1%psi + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%psi,1),UBOUND(u_out%psi,1) + b = (t(3)**2*(u1%psi(i1) - u2%psi(i1)) + t(2)**2*(-u1%psi(i1) + u3%psi(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%psi(i1) + t(3)*u2%psi(i1) - t(2)*u3%psi(i1) ) * scaleFactor + u_out%psi(i1) = u1%psi(i1) + b + c * t_out + END DO END IF ! check if allocated - b0 = (t(3)**2*(u1%omega - u2%omega) + t(2)**2*(-u1%omega + u3%omega))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%omega + t(3)*u2%omega - t(2)*u3%omega ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%omega = u1%omega + b0 * t_out + c0 * t_out**2 + b = (t(3)**2*(u1%omega - u2%omega) + t(2)**2*(-u1%omega + u3%omega))* scaleFactor + c = ( (t(2)-t(3))*u1%omega + t(3)*u2%omega - t(2)*u3%omega ) * scaleFactor + u_out%omega = u1%omega + b + c * t_out IF (ALLOCATED(u_out%Vx) .AND. ALLOCATED(u1%Vx)) THEN - ALLOCATE(b2(SIZE(u_out%Vx,1),SIZE(u_out%Vx,2) )) - ALLOCATE(c2(SIZE(u_out%Vx,1),SIZE(u_out%Vx,2) )) - b2 = (t(3)**2*(u1%Vx - u2%Vx) + t(2)**2*(-u1%Vx + u3%Vx))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%Vx + t(3)*u2%Vx - t(2)*u3%Vx ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Vx = u1%Vx + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%Vx,2),UBOUND(u_out%Vx,2) + DO i1 = LBOUND(u_out%Vx,1),UBOUND(u_out%Vx,1) + b = (t(3)**2*(u1%Vx(i1,i2) - u2%Vx(i1,i2)) + t(2)**2*(-u1%Vx(i1,i2) + u3%Vx(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%Vx(i1,i2) + t(3)*u2%Vx(i1,i2) - t(2)*u3%Vx(i1,i2) ) * scaleFactor + u_out%Vx(i1,i2) = u1%Vx(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated IF (ALLOCATED(u_out%Vy) .AND. ALLOCATED(u1%Vy)) THEN - ALLOCATE(b2(SIZE(u_out%Vy,1),SIZE(u_out%Vy,2) )) - ALLOCATE(c2(SIZE(u_out%Vy,1),SIZE(u_out%Vy,2) )) - b2 = (t(3)**2*(u1%Vy - u2%Vy) + t(2)**2*(-u1%Vy + u3%Vy))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%Vy + t(3)*u2%Vy - t(2)*u3%Vy ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Vy = u1%Vy + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%Vy,2),UBOUND(u_out%Vy,2) + DO i1 = LBOUND(u_out%Vy,1),UBOUND(u_out%Vy,1) + b = (t(3)**2*(u1%Vy(i1,i2) - u2%Vy(i1,i2)) + t(2)**2*(-u1%Vy(i1,i2) + u3%Vy(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%Vy(i1,i2) + t(3)*u2%Vy(i1,i2) - t(2)*u3%Vy(i1,i2) ) * scaleFactor + u_out%Vy(i1,i2) = u1%Vy(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated IF (ALLOCATED(u_out%rLocal) .AND. ALLOCATED(u1%rLocal)) THEN - ALLOCATE(b2(SIZE(u_out%rLocal,1),SIZE(u_out%rLocal,2) )) - ALLOCATE(c2(SIZE(u_out%rLocal,1),SIZE(u_out%rLocal,2) )) - b2 = (t(3)**2*(u1%rLocal - u2%rLocal) + t(2)**2*(-u1%rLocal + u3%rLocal))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%rLocal + t(3)*u2%rLocal - t(2)*u3%rLocal ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%rLocal = u1%rLocal + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%rLocal,2),UBOUND(u_out%rLocal,2) + DO i1 = LBOUND(u_out%rLocal,1),UBOUND(u_out%rLocal,1) + b = (t(3)**2*(u1%rLocal(i1,i2) - u2%rLocal(i1,i2)) + t(2)**2*(-u1%rLocal(i1,i2) + u3%rLocal(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%rLocal(i1,i2) + t(3)*u2%rLocal(i1,i2) - t(2)*u3%rLocal(i1,i2) ) * scaleFactor + u_out%rLocal(i1,i2) = u1%rLocal(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated - b0 = (t(3)**2*(u1%Un_disk - u2%Un_disk) + t(2)**2*(-u1%Un_disk + u3%Un_disk))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%Un_disk + t(3)*u2%Un_disk - t(2)*u3%Un_disk ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Un_disk = u1%Un_disk + b0 * t_out + c0 * t_out**2 + b = (t(3)**2*(u1%Un_disk - u2%Un_disk) + t(2)**2*(-u1%Un_disk + u3%Un_disk))* scaleFactor + c = ( (t(2)-t(3))*u1%Un_disk + t(3)*u2%Un_disk - t(2)*u3%Un_disk ) * scaleFactor + u_out%Un_disk = u1%Un_disk + b + c * t_out IF (ALLOCATED(u_out%UserProp) .AND. ALLOCATED(u1%UserProp)) THEN - ALLOCATE(b2(SIZE(u_out%UserProp,1),SIZE(u_out%UserProp,2) )) - ALLOCATE(c2(SIZE(u_out%UserProp,1),SIZE(u_out%UserProp,2) )) - b2 = (t(3)**2*(u1%UserProp - u2%UserProp) + t(2)**2*(-u1%UserProp + u3%UserProp))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%UserProp + t(3)*u2%UserProp - t(2)*u3%UserProp ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%UserProp = u1%UserProp + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%UserProp,2),UBOUND(u_out%UserProp,2) + DO i1 = LBOUND(u_out%UserProp,1),UBOUND(u_out%UserProp,1) + b = (t(3)**2*(u1%UserProp(i1,i2) - u2%UserProp(i1,i2)) + t(2)**2*(-u1%UserProp(i1,i2) + u3%UserProp(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%UserProp(i1,i2) + t(3)*u2%UserProp(i1,i2) - t(2)*u3%UserProp(i1,i2) ) * scaleFactor + u_out%UserProp(i1,i2) = u1%UserProp(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated END SUBROUTINE BEMT_Input_ExtrapInterp2 @@ -5365,14 +5324,14 @@ SUBROUTINE BEMT_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -5385,109 +5344,111 @@ SUBROUTINE BEMT_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) IF (ALLOCATED(y_out%Vrel) .AND. ALLOCATED(y1%Vrel)) THEN - ALLOCATE(b2(SIZE(y_out%Vrel,1),SIZE(y_out%Vrel,2) )) - ALLOCATE(c2(SIZE(y_out%Vrel,1),SIZE(y_out%Vrel,2) )) - b2 = -(y1%Vrel - y2%Vrel)/t(2) - y_out%Vrel = y1%Vrel + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%Vrel,2),UBOUND(y_out%Vrel,2) + DO i1 = LBOUND(y_out%Vrel,1),UBOUND(y_out%Vrel,1) + b = -(y1%Vrel(i1,i2) - y2%Vrel(i1,i2)) + y_out%Vrel(i1,i2) = y1%Vrel(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%phi) .AND. ALLOCATED(y1%phi)) THEN - ALLOCATE(b2(SIZE(y_out%phi,1),SIZE(y_out%phi,2) )) - ALLOCATE(c2(SIZE(y_out%phi,1),SIZE(y_out%phi,2) )) - b2 = -(y1%phi - y2%phi)/t(2) - y_out%phi = y1%phi + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%phi,2),UBOUND(y_out%phi,2) + DO i1 = LBOUND(y_out%phi,1),UBOUND(y_out%phi,1) + b = -(y1%phi(i1,i2) - y2%phi(i1,i2)) + y_out%phi(i1,i2) = y1%phi(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%axInduction) .AND. ALLOCATED(y1%axInduction)) THEN - ALLOCATE(b2(SIZE(y_out%axInduction,1),SIZE(y_out%axInduction,2) )) - ALLOCATE(c2(SIZE(y_out%axInduction,1),SIZE(y_out%axInduction,2) )) - b2 = -(y1%axInduction - y2%axInduction)/t(2) - y_out%axInduction = y1%axInduction + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%axInduction,2),UBOUND(y_out%axInduction,2) + DO i1 = LBOUND(y_out%axInduction,1),UBOUND(y_out%axInduction,1) + b = -(y1%axInduction(i1,i2) - y2%axInduction(i1,i2)) + y_out%axInduction(i1,i2) = y1%axInduction(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%tanInduction) .AND. ALLOCATED(y1%tanInduction)) THEN - ALLOCATE(b2(SIZE(y_out%tanInduction,1),SIZE(y_out%tanInduction,2) )) - ALLOCATE(c2(SIZE(y_out%tanInduction,1),SIZE(y_out%tanInduction,2) )) - b2 = -(y1%tanInduction - y2%tanInduction)/t(2) - y_out%tanInduction = y1%tanInduction + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%tanInduction,2),UBOUND(y_out%tanInduction,2) + DO i1 = LBOUND(y_out%tanInduction,1),UBOUND(y_out%tanInduction,1) + b = -(y1%tanInduction(i1,i2) - y2%tanInduction(i1,i2)) + y_out%tanInduction(i1,i2) = y1%tanInduction(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%Re) .AND. ALLOCATED(y1%Re)) THEN - ALLOCATE(b2(SIZE(y_out%Re,1),SIZE(y_out%Re,2) )) - ALLOCATE(c2(SIZE(y_out%Re,1),SIZE(y_out%Re,2) )) - b2 = -(y1%Re - y2%Re)/t(2) - y_out%Re = y1%Re + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%Re,2),UBOUND(y_out%Re,2) + DO i1 = LBOUND(y_out%Re,1),UBOUND(y_out%Re,1) + b = -(y1%Re(i1,i2) - y2%Re(i1,i2)) + y_out%Re(i1,i2) = y1%Re(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%AOA) .AND. ALLOCATED(y1%AOA)) THEN - ALLOCATE(b2(SIZE(y_out%AOA,1),SIZE(y_out%AOA,2) )) - ALLOCATE(c2(SIZE(y_out%AOA,1),SIZE(y_out%AOA,2) )) - b2 = -(y1%AOA - y2%AOA)/t(2) - y_out%AOA = y1%AOA + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%AOA,2),UBOUND(y_out%AOA,2) + DO i1 = LBOUND(y_out%AOA,1),UBOUND(y_out%AOA,1) + b = -(y1%AOA(i1,i2) - y2%AOA(i1,i2)) + y_out%AOA(i1,i2) = y1%AOA(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%Cx) .AND. ALLOCATED(y1%Cx)) THEN - ALLOCATE(b2(SIZE(y_out%Cx,1),SIZE(y_out%Cx,2) )) - ALLOCATE(c2(SIZE(y_out%Cx,1),SIZE(y_out%Cx,2) )) - b2 = -(y1%Cx - y2%Cx)/t(2) - y_out%Cx = y1%Cx + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%Cx,2),UBOUND(y_out%Cx,2) + DO i1 = LBOUND(y_out%Cx,1),UBOUND(y_out%Cx,1) + b = -(y1%Cx(i1,i2) - y2%Cx(i1,i2)) + y_out%Cx(i1,i2) = y1%Cx(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%Cy) .AND. ALLOCATED(y1%Cy)) THEN - ALLOCATE(b2(SIZE(y_out%Cy,1),SIZE(y_out%Cy,2) )) - ALLOCATE(c2(SIZE(y_out%Cy,1),SIZE(y_out%Cy,2) )) - b2 = -(y1%Cy - y2%Cy)/t(2) - y_out%Cy = y1%Cy + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%Cy,2),UBOUND(y_out%Cy,2) + DO i1 = LBOUND(y_out%Cy,1),UBOUND(y_out%Cy,1) + b = -(y1%Cy(i1,i2) - y2%Cy(i1,i2)) + y_out%Cy(i1,i2) = y1%Cy(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%Cm) .AND. ALLOCATED(y1%Cm)) THEN - ALLOCATE(b2(SIZE(y_out%Cm,1),SIZE(y_out%Cm,2) )) - ALLOCATE(c2(SIZE(y_out%Cm,1),SIZE(y_out%Cm,2) )) - b2 = -(y1%Cm - y2%Cm)/t(2) - y_out%Cm = y1%Cm + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%Cm,2),UBOUND(y_out%Cm,2) + DO i1 = LBOUND(y_out%Cm,1),UBOUND(y_out%Cm,1) + b = -(y1%Cm(i1,i2) - y2%Cm(i1,i2)) + y_out%Cm(i1,i2) = y1%Cm(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%Cl) .AND. ALLOCATED(y1%Cl)) THEN - ALLOCATE(b2(SIZE(y_out%Cl,1),SIZE(y_out%Cl,2) )) - ALLOCATE(c2(SIZE(y_out%Cl,1),SIZE(y_out%Cl,2) )) - b2 = -(y1%Cl - y2%Cl)/t(2) - y_out%Cl = y1%Cl + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%Cl,2),UBOUND(y_out%Cl,2) + DO i1 = LBOUND(y_out%Cl,1),UBOUND(y_out%Cl,1) + b = -(y1%Cl(i1,i2) - y2%Cl(i1,i2)) + y_out%Cl(i1,i2) = y1%Cl(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%Cd) .AND. ALLOCATED(y1%Cd)) THEN - ALLOCATE(b2(SIZE(y_out%Cd,1),SIZE(y_out%Cd,2) )) - ALLOCATE(c2(SIZE(y_out%Cd,1),SIZE(y_out%Cd,2) )) - b2 = -(y1%Cd - y2%Cd)/t(2) - y_out%Cd = y1%Cd + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%Cd,2),UBOUND(y_out%Cd,2) + DO i1 = LBOUND(y_out%Cd,1),UBOUND(y_out%Cd,1) + b = -(y1%Cd(i1,i2) - y2%Cd(i1,i2)) + y_out%Cd(i1,i2) = y1%Cd(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%chi) .AND. ALLOCATED(y1%chi)) THEN - ALLOCATE(b2(SIZE(y_out%chi,1),SIZE(y_out%chi,2) )) - ALLOCATE(c2(SIZE(y_out%chi,1),SIZE(y_out%chi,2) )) - b2 = -(y1%chi - y2%chi)/t(2) - y_out%chi = y1%chi + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%chi,2),UBOUND(y_out%chi,2) + DO i1 = LBOUND(y_out%chi,1),UBOUND(y_out%chi,1) + b = -(y1%chi(i1,i2) - y2%chi(i1,i2)) + y_out%chi(i1,i2) = y1%chi(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%Cpmin) .AND. ALLOCATED(y1%Cpmin)) THEN - ALLOCATE(b2(SIZE(y_out%Cpmin,1),SIZE(y_out%Cpmin,2) )) - ALLOCATE(c2(SIZE(y_out%Cpmin,1),SIZE(y_out%Cpmin,2) )) - b2 = -(y1%Cpmin - y2%Cpmin)/t(2) - y_out%Cpmin = y1%Cpmin + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%Cpmin,2),UBOUND(y_out%Cpmin,2) + DO i1 = LBOUND(y_out%Cpmin,1),UBOUND(y_out%Cpmin,1) + b = -(y1%Cpmin(i1,i2) - y2%Cpmin(i1,i2)) + y_out%Cpmin(i1,i2) = y1%Cpmin(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated END SUBROUTINE BEMT_Output_ExtrapInterp1 @@ -5518,15 +5479,16 @@ SUBROUTINE BEMT_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'BEMT_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -5545,122 +5507,124 @@ SUBROUTINE BEMT_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) IF (ALLOCATED(y_out%Vrel) .AND. ALLOCATED(y1%Vrel)) THEN - ALLOCATE(b2(SIZE(y_out%Vrel,1),SIZE(y_out%Vrel,2) )) - ALLOCATE(c2(SIZE(y_out%Vrel,1),SIZE(y_out%Vrel,2) )) - b2 = (t(3)**2*(y1%Vrel - y2%Vrel) + t(2)**2*(-y1%Vrel + y3%Vrel))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*y1%Vrel + t(3)*y2%Vrel - t(2)*y3%Vrel ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Vrel = y1%Vrel + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%Vrel,2),UBOUND(y_out%Vrel,2) + DO i1 = LBOUND(y_out%Vrel,1),UBOUND(y_out%Vrel,1) + b = (t(3)**2*(y1%Vrel(i1,i2) - y2%Vrel(i1,i2)) + t(2)**2*(-y1%Vrel(i1,i2) + y3%Vrel(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*y1%Vrel(i1,i2) + t(3)*y2%Vrel(i1,i2) - t(2)*y3%Vrel(i1,i2) ) * scaleFactor + y_out%Vrel(i1,i2) = y1%Vrel(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%phi) .AND. ALLOCATED(y1%phi)) THEN - ALLOCATE(b2(SIZE(y_out%phi,1),SIZE(y_out%phi,2) )) - ALLOCATE(c2(SIZE(y_out%phi,1),SIZE(y_out%phi,2) )) - b2 = (t(3)**2*(y1%phi - y2%phi) + t(2)**2*(-y1%phi + y3%phi))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*y1%phi + t(3)*y2%phi - t(2)*y3%phi ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%phi = y1%phi + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%phi,2),UBOUND(y_out%phi,2) + DO i1 = LBOUND(y_out%phi,1),UBOUND(y_out%phi,1) + b = (t(3)**2*(y1%phi(i1,i2) - y2%phi(i1,i2)) + t(2)**2*(-y1%phi(i1,i2) + y3%phi(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*y1%phi(i1,i2) + t(3)*y2%phi(i1,i2) - t(2)*y3%phi(i1,i2) ) * scaleFactor + y_out%phi(i1,i2) = y1%phi(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%axInduction) .AND. ALLOCATED(y1%axInduction)) THEN - ALLOCATE(b2(SIZE(y_out%axInduction,1),SIZE(y_out%axInduction,2) )) - ALLOCATE(c2(SIZE(y_out%axInduction,1),SIZE(y_out%axInduction,2) )) - b2 = (t(3)**2*(y1%axInduction - y2%axInduction) + t(2)**2*(-y1%axInduction + y3%axInduction))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*y1%axInduction + t(3)*y2%axInduction - t(2)*y3%axInduction ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%axInduction = y1%axInduction + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%axInduction,2),UBOUND(y_out%axInduction,2) + DO i1 = LBOUND(y_out%axInduction,1),UBOUND(y_out%axInduction,1) + b = (t(3)**2*(y1%axInduction(i1,i2) - y2%axInduction(i1,i2)) + t(2)**2*(-y1%axInduction(i1,i2) + y3%axInduction(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*y1%axInduction(i1,i2) + t(3)*y2%axInduction(i1,i2) - t(2)*y3%axInduction(i1,i2) ) * scaleFactor + y_out%axInduction(i1,i2) = y1%axInduction(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%tanInduction) .AND. ALLOCATED(y1%tanInduction)) THEN - ALLOCATE(b2(SIZE(y_out%tanInduction,1),SIZE(y_out%tanInduction,2) )) - ALLOCATE(c2(SIZE(y_out%tanInduction,1),SIZE(y_out%tanInduction,2) )) - b2 = (t(3)**2*(y1%tanInduction - y2%tanInduction) + t(2)**2*(-y1%tanInduction + y3%tanInduction))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*y1%tanInduction + t(3)*y2%tanInduction - t(2)*y3%tanInduction ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%tanInduction = y1%tanInduction + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%tanInduction,2),UBOUND(y_out%tanInduction,2) + DO i1 = LBOUND(y_out%tanInduction,1),UBOUND(y_out%tanInduction,1) + b = (t(3)**2*(y1%tanInduction(i1,i2) - y2%tanInduction(i1,i2)) + t(2)**2*(-y1%tanInduction(i1,i2) + y3%tanInduction(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*y1%tanInduction(i1,i2) + t(3)*y2%tanInduction(i1,i2) - t(2)*y3%tanInduction(i1,i2) ) * scaleFactor + y_out%tanInduction(i1,i2) = y1%tanInduction(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%Re) .AND. ALLOCATED(y1%Re)) THEN - ALLOCATE(b2(SIZE(y_out%Re,1),SIZE(y_out%Re,2) )) - ALLOCATE(c2(SIZE(y_out%Re,1),SIZE(y_out%Re,2) )) - b2 = (t(3)**2*(y1%Re - y2%Re) + t(2)**2*(-y1%Re + y3%Re))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*y1%Re + t(3)*y2%Re - t(2)*y3%Re ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Re = y1%Re + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%Re,2),UBOUND(y_out%Re,2) + DO i1 = LBOUND(y_out%Re,1),UBOUND(y_out%Re,1) + b = (t(3)**2*(y1%Re(i1,i2) - y2%Re(i1,i2)) + t(2)**2*(-y1%Re(i1,i2) + y3%Re(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*y1%Re(i1,i2) + t(3)*y2%Re(i1,i2) - t(2)*y3%Re(i1,i2) ) * scaleFactor + y_out%Re(i1,i2) = y1%Re(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%AOA) .AND. ALLOCATED(y1%AOA)) THEN - ALLOCATE(b2(SIZE(y_out%AOA,1),SIZE(y_out%AOA,2) )) - ALLOCATE(c2(SIZE(y_out%AOA,1),SIZE(y_out%AOA,2) )) - b2 = (t(3)**2*(y1%AOA - y2%AOA) + t(2)**2*(-y1%AOA + y3%AOA))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*y1%AOA + t(3)*y2%AOA - t(2)*y3%AOA ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%AOA = y1%AOA + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%AOA,2),UBOUND(y_out%AOA,2) + DO i1 = LBOUND(y_out%AOA,1),UBOUND(y_out%AOA,1) + b = (t(3)**2*(y1%AOA(i1,i2) - y2%AOA(i1,i2)) + t(2)**2*(-y1%AOA(i1,i2) + y3%AOA(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*y1%AOA(i1,i2) + t(3)*y2%AOA(i1,i2) - t(2)*y3%AOA(i1,i2) ) * scaleFactor + y_out%AOA(i1,i2) = y1%AOA(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%Cx) .AND. ALLOCATED(y1%Cx)) THEN - ALLOCATE(b2(SIZE(y_out%Cx,1),SIZE(y_out%Cx,2) )) - ALLOCATE(c2(SIZE(y_out%Cx,1),SIZE(y_out%Cx,2) )) - b2 = (t(3)**2*(y1%Cx - y2%Cx) + t(2)**2*(-y1%Cx + y3%Cx))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*y1%Cx + t(3)*y2%Cx - t(2)*y3%Cx ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Cx = y1%Cx + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%Cx,2),UBOUND(y_out%Cx,2) + DO i1 = LBOUND(y_out%Cx,1),UBOUND(y_out%Cx,1) + b = (t(3)**2*(y1%Cx(i1,i2) - y2%Cx(i1,i2)) + t(2)**2*(-y1%Cx(i1,i2) + y3%Cx(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*y1%Cx(i1,i2) + t(3)*y2%Cx(i1,i2) - t(2)*y3%Cx(i1,i2) ) * scaleFactor + y_out%Cx(i1,i2) = y1%Cx(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%Cy) .AND. ALLOCATED(y1%Cy)) THEN - ALLOCATE(b2(SIZE(y_out%Cy,1),SIZE(y_out%Cy,2) )) - ALLOCATE(c2(SIZE(y_out%Cy,1),SIZE(y_out%Cy,2) )) - b2 = (t(3)**2*(y1%Cy - y2%Cy) + t(2)**2*(-y1%Cy + y3%Cy))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*y1%Cy + t(3)*y2%Cy - t(2)*y3%Cy ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Cy = y1%Cy + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%Cy,2),UBOUND(y_out%Cy,2) + DO i1 = LBOUND(y_out%Cy,1),UBOUND(y_out%Cy,1) + b = (t(3)**2*(y1%Cy(i1,i2) - y2%Cy(i1,i2)) + t(2)**2*(-y1%Cy(i1,i2) + y3%Cy(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*y1%Cy(i1,i2) + t(3)*y2%Cy(i1,i2) - t(2)*y3%Cy(i1,i2) ) * scaleFactor + y_out%Cy(i1,i2) = y1%Cy(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%Cm) .AND. ALLOCATED(y1%Cm)) THEN - ALLOCATE(b2(SIZE(y_out%Cm,1),SIZE(y_out%Cm,2) )) - ALLOCATE(c2(SIZE(y_out%Cm,1),SIZE(y_out%Cm,2) )) - b2 = (t(3)**2*(y1%Cm - y2%Cm) + t(2)**2*(-y1%Cm + y3%Cm))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*y1%Cm + t(3)*y2%Cm - t(2)*y3%Cm ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Cm = y1%Cm + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%Cm,2),UBOUND(y_out%Cm,2) + DO i1 = LBOUND(y_out%Cm,1),UBOUND(y_out%Cm,1) + b = (t(3)**2*(y1%Cm(i1,i2) - y2%Cm(i1,i2)) + t(2)**2*(-y1%Cm(i1,i2) + y3%Cm(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*y1%Cm(i1,i2) + t(3)*y2%Cm(i1,i2) - t(2)*y3%Cm(i1,i2) ) * scaleFactor + y_out%Cm(i1,i2) = y1%Cm(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%Cl) .AND. ALLOCATED(y1%Cl)) THEN - ALLOCATE(b2(SIZE(y_out%Cl,1),SIZE(y_out%Cl,2) )) - ALLOCATE(c2(SIZE(y_out%Cl,1),SIZE(y_out%Cl,2) )) - b2 = (t(3)**2*(y1%Cl - y2%Cl) + t(2)**2*(-y1%Cl + y3%Cl))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*y1%Cl + t(3)*y2%Cl - t(2)*y3%Cl ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Cl = y1%Cl + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%Cl,2),UBOUND(y_out%Cl,2) + DO i1 = LBOUND(y_out%Cl,1),UBOUND(y_out%Cl,1) + b = (t(3)**2*(y1%Cl(i1,i2) - y2%Cl(i1,i2)) + t(2)**2*(-y1%Cl(i1,i2) + y3%Cl(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*y1%Cl(i1,i2) + t(3)*y2%Cl(i1,i2) - t(2)*y3%Cl(i1,i2) ) * scaleFactor + y_out%Cl(i1,i2) = y1%Cl(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%Cd) .AND. ALLOCATED(y1%Cd)) THEN - ALLOCATE(b2(SIZE(y_out%Cd,1),SIZE(y_out%Cd,2) )) - ALLOCATE(c2(SIZE(y_out%Cd,1),SIZE(y_out%Cd,2) )) - b2 = (t(3)**2*(y1%Cd - y2%Cd) + t(2)**2*(-y1%Cd + y3%Cd))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*y1%Cd + t(3)*y2%Cd - t(2)*y3%Cd ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Cd = y1%Cd + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%Cd,2),UBOUND(y_out%Cd,2) + DO i1 = LBOUND(y_out%Cd,1),UBOUND(y_out%Cd,1) + b = (t(3)**2*(y1%Cd(i1,i2) - y2%Cd(i1,i2)) + t(2)**2*(-y1%Cd(i1,i2) + y3%Cd(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*y1%Cd(i1,i2) + t(3)*y2%Cd(i1,i2) - t(2)*y3%Cd(i1,i2) ) * scaleFactor + y_out%Cd(i1,i2) = y1%Cd(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%chi) .AND. ALLOCATED(y1%chi)) THEN - ALLOCATE(b2(SIZE(y_out%chi,1),SIZE(y_out%chi,2) )) - ALLOCATE(c2(SIZE(y_out%chi,1),SIZE(y_out%chi,2) )) - b2 = (t(3)**2*(y1%chi - y2%chi) + t(2)**2*(-y1%chi + y3%chi))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*y1%chi + t(3)*y2%chi - t(2)*y3%chi ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%chi = y1%chi + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%chi,2),UBOUND(y_out%chi,2) + DO i1 = LBOUND(y_out%chi,1),UBOUND(y_out%chi,1) + b = (t(3)**2*(y1%chi(i1,i2) - y2%chi(i1,i2)) + t(2)**2*(-y1%chi(i1,i2) + y3%chi(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*y1%chi(i1,i2) + t(3)*y2%chi(i1,i2) - t(2)*y3%chi(i1,i2) ) * scaleFactor + y_out%chi(i1,i2) = y1%chi(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%Cpmin) .AND. ALLOCATED(y1%Cpmin)) THEN - ALLOCATE(b2(SIZE(y_out%Cpmin,1),SIZE(y_out%Cpmin,2) )) - ALLOCATE(c2(SIZE(y_out%Cpmin,1),SIZE(y_out%Cpmin,2) )) - b2 = (t(3)**2*(y1%Cpmin - y2%Cpmin) + t(2)**2*(-y1%Cpmin + y3%Cpmin))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*y1%Cpmin + t(3)*y2%Cpmin - t(2)*y3%Cpmin ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Cpmin = y1%Cpmin + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%Cpmin,2),UBOUND(y_out%Cpmin,2) + DO i1 = LBOUND(y_out%Cpmin,1),UBOUND(y_out%Cpmin,1) + b = (t(3)**2*(y1%Cpmin(i1,i2) - y2%Cpmin(i1,i2)) + t(2)**2*(-y1%Cpmin(i1,i2) + y3%Cpmin(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*y1%Cpmin(i1,i2) + t(3)*y2%Cpmin(i1,i2) - t(2)*y3%Cpmin(i1,i2) ) * scaleFactor + y_out%Cpmin(i1,i2) = y1%Cpmin(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated END SUBROUTINE BEMT_Output_ExtrapInterp2 diff --git a/modules/aerodyn/src/DBEMT.f90 b/modules/aerodyn/src/DBEMT.f90 index 981f5f5f3e..a9f63471bd 100644 --- a/modules/aerodyn/src/DBEMT.f90 +++ b/modules/aerodyn/src/DBEMT.f90 @@ -38,7 +38,7 @@ module DBEMT subroutine DBEMT_ValidateInitInp(interval, InitInp, errStat, errMsg) - real(DbKi), intent(inout) :: interval !< Coupling interval in seconds: the rate that + real(DbKi), intent(in ) :: interval !< Coupling interval in seconds type(DBEMT_InitInputType), intent(in ) :: InitInp !< Input data for initialization routine integer(IntKi), intent( out) :: errStat !< Error status of the operation character(*), intent( out) :: errMsg !< Error message if ErrStat /= ErrID_None @@ -98,7 +98,7 @@ subroutine DBEMT_Init( InitInp, u, p, x, OtherState, m, Interval, InitOut, ErrSt type(DBEMT_ContinuousStateType), intent( out) :: x !< Initial continuous states type(DBEMT_OtherStateType), intent( out) :: OtherState !< Initial other/logical states type(DBEMT_MiscVarType), intent( out) :: m !< Initial misc/optimization variables - real(DbKi), intent(inout) :: interval !< Coupling interval in seconds: the rate that + real(DbKi), intent(in ) :: interval !< Coupling interval in seconds: the rate that !! (1) DBEMT_UpdateStates() is called in loose coupling & !! (2) DBEMT_UpdateDiscState() is called in tight coupling. !! Input is the suggested time from the glue code; @@ -234,9 +234,7 @@ subroutine DBEMT_UpdateStates( i, j, t, u, p, x, OtherState, m, errStat, errMsg ! local variables real(ReKi) :: spanRatio ! local version of r / R - real(ReKi) :: temp, tau2 , A, B, C0, k_tau, C0_2 ! tau1_plus1, C_tau1, C, K1 - real(ReKi) :: Un_disk - real(ReKi) :: AxInd_disk + real(ReKi) :: tau2 , A, B, C0, k_tau, C0_2 ! tau1_plus1, C_tau1, C, K1 integer(IntKi) :: indx character(*), parameter :: RoutineName = 'DBEMT_UpdateStates' diff --git a/modules/aerodyn/src/DBEMT_Types.f90 b/modules/aerodyn/src/DBEMT_Types.f90 index 278226f56c..2f3fa7499c 100644 --- a/modules/aerodyn/src/DBEMT_Types.f90 +++ b/modules/aerodyn/src/DBEMT_Types.f90 @@ -266,24 +266,24 @@ SUBROUTINE DBEMT_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumBlades - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumNodes - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%k_0ye - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%c5 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%c6 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%c7 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%c8 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%c9 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%tau1_const - Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumBlades + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumNodes + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k_0ye + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%c5 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%c6 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%c7 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%c8 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%c9 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%tau1_const + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%spanRatio) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -297,11 +297,15 @@ SUBROUTINE DBEMT_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%spanRatio,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%spanRatio)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%spanRatio))-1 ) = PACK(InData%spanRatio,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%spanRatio) + DO i2 = LBOUND(InData%spanRatio,2), UBOUND(InData%spanRatio,2) + DO i1 = LBOUND(InData%spanRatio,1), UBOUND(InData%spanRatio,1) + ReKiBuf(Re_Xferred) = InData%spanRatio(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DBEMT_Mod - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DBEMT_Mod + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%rLocal) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -315,8 +319,12 @@ SUBROUTINE DBEMT_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rLocal,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%rLocal)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%rLocal))-1 ) = PACK(InData%rLocal,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%rLocal) + DO i2 = LBOUND(InData%rLocal,2), UBOUND(InData%rLocal,2) + DO i1 = LBOUND(InData%rLocal,1), UBOUND(InData%rLocal,1) + ReKiBuf(Re_Xferred) = InData%rLocal(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE DBEMT_PackInitInput @@ -333,12 +341,6 @@ SUBROUTINE DBEMT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (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 @@ -355,24 +357,24 @@ SUBROUTINE DBEMT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%NumBlades = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumNodes = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%k_0ye = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%c5 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%c6 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%c7 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%c8 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%c9 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%tau1_const = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%NumBlades = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumNodes = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%k_0ye = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%c5 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%c6 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%c7 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%c8 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%c9 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%tau1_const = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! spanRatio not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -389,18 +391,15 @@ SUBROUTINE DBEMT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%spanRatio.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%spanRatio)>0) OutData%spanRatio = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%spanRatio))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%spanRatio) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%spanRatio,2), UBOUND(OutData%spanRatio,2) + DO i1 = LBOUND(OutData%spanRatio,1), UBOUND(OutData%spanRatio,1) + OutData%spanRatio(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - OutData%DBEMT_Mod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%DBEMT_Mod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rLocal not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -417,15 +416,12 @@ SUBROUTINE DBEMT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rLocal.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%rLocal)>0) OutData%rLocal = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%rLocal))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%rLocal) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%rLocal,2), UBOUND(OutData%rLocal,2) + DO i1 = LBOUND(OutData%rLocal,1), UBOUND(OutData%rLocal,1) + OutData%rLocal(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE DBEMT_UnPackInitInput @@ -583,12 +579,6 @@ SUBROUTINE DBEMT_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_UnPackInitOutput' @@ -800,8 +790,14 @@ SUBROUTINE DBEMT_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vind,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%vind)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%vind))-1 ) = PACK(InData%vind,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%vind) + DO i3 = LBOUND(InData%vind,3), UBOUND(InData%vind,3) + DO i2 = LBOUND(InData%vind,2), UBOUND(InData%vind,2) + DO i1 = LBOUND(InData%vind,1), UBOUND(InData%vind,1) + ReKiBuf(Re_Xferred) = InData%vind(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%vind_1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -819,8 +815,14 @@ SUBROUTINE DBEMT_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vind_1,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%vind_1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%vind_1))-1 ) = PACK(InData%vind_1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%vind_1) + DO i3 = LBOUND(InData%vind_1,3), UBOUND(InData%vind_1,3) + DO i2 = LBOUND(InData%vind_1,2), UBOUND(InData%vind_1,2) + DO i1 = LBOUND(InData%vind_1,1), UBOUND(InData%vind_1,1) + ReKiBuf(Re_Xferred) = InData%vind_1(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF END SUBROUTINE DBEMT_PackContState @@ -837,12 +839,6 @@ SUBROUTINE DBEMT_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (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 @@ -878,15 +874,14 @@ SUBROUTINE DBEMT_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%vind.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%vind)>0) OutData%vind = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%vind))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%vind) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%vind,3), UBOUND(OutData%vind,3) + DO i2 = LBOUND(OutData%vind,2), UBOUND(OutData%vind,2) + DO i1 = LBOUND(OutData%vind,1), UBOUND(OutData%vind,1) + OutData%vind(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! vind_1 not allocated Int_Xferred = Int_Xferred + 1 @@ -907,15 +902,14 @@ SUBROUTINE DBEMT_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%vind_1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%vind_1)>0) OutData%vind_1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%vind_1))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%vind_1) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%vind_1,3), UBOUND(OutData%vind_1,3) + DO i2 = LBOUND(OutData%vind_1,2), UBOUND(OutData%vind_1,2) + DO i1 = LBOUND(OutData%vind_1,1), UBOUND(OutData%vind_1,1) + OutData%vind_1(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF END SUBROUTINE DBEMT_UnPackContState @@ -1010,8 +1004,8 @@ SUBROUTINE DBEMT_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyDiscreteState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyDiscreteState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE DBEMT_PackDiscState SUBROUTINE DBEMT_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1027,12 +1021,6 @@ SUBROUTINE DBEMT_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_UnPackDiscState' @@ -1046,8 +1034,8 @@ SUBROUTINE DBEMT_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyDiscreteState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyDiscreteState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE DBEMT_UnPackDiscState SUBROUTINE DBEMT_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) @@ -1141,8 +1129,8 @@ SUBROUTINE DBEMT_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyContState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyContState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE DBEMT_PackConstrState SUBROUTINE DBEMT_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1158,12 +1146,6 @@ SUBROUTINE DBEMT_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_UnPackConstrState' @@ -1177,8 +1159,8 @@ SUBROUTINE DBEMT_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyContState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyContState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE DBEMT_UnPackConstrState SUBROUTINE DBEMT_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -1309,11 +1291,15 @@ SUBROUTINE DBEMT_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%areStatesInitialized,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%areStatesInitialized)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%areStatesInitialized)-1 ) = TRANSFER(PACK( InData%areStatesInitialized ,.TRUE.), IntKiBuf(1), SIZE(InData%areStatesInitialized)) - Int_Xferred = Int_Xferred + SIZE(InData%areStatesInitialized) + DO i2 = LBOUND(InData%areStatesInitialized,2), UBOUND(InData%areStatesInitialized,2) + DO i1 = LBOUND(InData%areStatesInitialized,1), UBOUND(InData%areStatesInitialized,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%areStatesInitialized(i1,i2), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%tau1 - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%tau1 + Re_Xferred = Re_Xferred + 1 END SUBROUTINE DBEMT_PackOtherState SUBROUTINE DBEMT_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1329,12 +1315,6 @@ SUBROUTINE DBEMT_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -1366,18 +1346,15 @@ SUBROUTINE DBEMT_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%areStatesInitialized.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%areStatesInitialized)>0) OutData%areStatesInitialized = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%areStatesInitialized))-1 ), OutData%areStatesInitialized), mask2,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%areStatesInitialized) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%areStatesInitialized,2), UBOUND(OutData%areStatesInitialized,2) + DO i1 = LBOUND(OutData%areStatesInitialized,1), UBOUND(OutData%areStatesInitialized,1) + OutData%areStatesInitialized(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%areStatesInitialized(i1,i2)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF - OutData%tau1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%tau1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE DBEMT_UnPackOtherState SUBROUTINE DBEMT_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) @@ -1471,8 +1448,8 @@ SUBROUTINE DBEMT_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%FirstWarn_tau1 , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%FirstWarn_tau1, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE DBEMT_PackMisc SUBROUTINE DBEMT_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1488,12 +1465,6 @@ SUBROUTINE DBEMT_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_UnPackMisc' @@ -1507,8 +1478,8 @@ SUBROUTINE DBEMT_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%FirstWarn_tau1 = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%FirstWarn_tau1 = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstWarn_tau1) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE DBEMT_UnPackMisc SUBROUTINE DBEMT_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -1636,16 +1607,16 @@ SUBROUTINE DBEMT_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumBlades - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumNodes - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%k_0ye - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%tau1_const - Re_Xferred = Re_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumBlades + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumNodes + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k_0ye + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%tau1_const + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%spanRatio) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1659,11 +1630,15 @@ SUBROUTINE DBEMT_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%spanRatio,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%spanRatio)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%spanRatio))-1 ) = PACK(InData%spanRatio,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%spanRatio) + DO i2 = LBOUND(InData%spanRatio,2), UBOUND(InData%spanRatio,2) + DO i1 = LBOUND(InData%spanRatio,1), UBOUND(InData%spanRatio,1) + ReKiBuf(Re_Xferred) = InData%spanRatio(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DBEMT_Mod - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DBEMT_Mod + Int_Xferred = Int_Xferred + 1 END SUBROUTINE DBEMT_PackParam SUBROUTINE DBEMT_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1679,12 +1654,6 @@ SUBROUTINE DBEMT_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -1700,16 +1669,16 @@ SUBROUTINE DBEMT_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%NumBlades = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumNodes = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%k_0ye = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%tau1_const = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%NumBlades = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumNodes = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%k_0ye = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%tau1_const = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! spanRatio not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1726,18 +1695,15 @@ SUBROUTINE DBEMT_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%spanRatio.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%spanRatio)>0) OutData%spanRatio = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%spanRatio))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%spanRatio) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%spanRatio,2), UBOUND(OutData%spanRatio,2) + DO i1 = LBOUND(OutData%spanRatio,1), UBOUND(OutData%spanRatio,1) + OutData%spanRatio(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - OutData%DBEMT_Mod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%DBEMT_Mod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE DBEMT_UnPackParam SUBROUTINE DBEMT_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -1840,16 +1806,18 @@ SUBROUTINE DBEMT_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AxInd_disk - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Un_disk - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%R_disk - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%vind_s))-1 ) = PACK(InData%vind_s,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%vind_s) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%spanRatio - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AxInd_disk + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Un_disk + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%R_disk + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%vind_s,1), UBOUND(InData%vind_s,1) + ReKiBuf(Re_Xferred) = InData%vind_s(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%spanRatio + Re_Xferred = Re_Xferred + 1 END SUBROUTINE DBEMT_PackInput SUBROUTINE DBEMT_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1865,12 +1833,6 @@ SUBROUTINE DBEMT_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1885,25 +1847,20 @@ SUBROUTINE DBEMT_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%AxInd_disk = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Un_disk = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%R_disk = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%AxInd_disk = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Un_disk = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%R_disk = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%vind_s,1) i1_u = UBOUND(OutData%vind_s,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%vind_s = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%vind_s))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%vind_s) - DEALLOCATE(mask1) - OutData%spanRatio = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%vind_s,1), UBOUND(OutData%vind_s,1) + OutData%vind_s(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%spanRatio = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE DBEMT_UnPackInput SUBROUTINE DBEMT_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -2038,8 +1995,14 @@ SUBROUTINE DBEMT_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vind,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%vind)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%vind))-1 ) = PACK(InData%vind,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%vind) + DO i3 = LBOUND(InData%vind,3), UBOUND(InData%vind,3) + DO i2 = LBOUND(InData%vind,2), UBOUND(InData%vind,2) + DO i1 = LBOUND(InData%vind,1), UBOUND(InData%vind,1) + ReKiBuf(Re_Xferred) = InData%vind(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF END SUBROUTINE DBEMT_PackOutput @@ -2056,12 +2019,6 @@ SUBROUTINE DBEMT_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (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 @@ -2097,15 +2054,14 @@ SUBROUTINE DBEMT_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%vind.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%vind)>0) OutData%vind = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%vind))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%vind) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%vind,3), UBOUND(OutData%vind,3) + DO i2 = LBOUND(OutData%vind,2), UBOUND(OutData%vind,2) + DO i1 = LBOUND(OutData%vind,1), UBOUND(OutData%vind,1) + OutData%vind(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF END SUBROUTINE DBEMT_UnPackOutput @@ -2184,12 +2140,12 @@ SUBROUTINE DBEMT_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMs REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -2202,20 +2158,20 @@ SUBROUTINE DBEMT_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - b0 = -(u1%AxInd_disk - u2%AxInd_disk)/t(2) - u_out%AxInd_disk = u1%AxInd_disk + b0 * t_out - b0 = -(u1%Un_disk - u2%Un_disk)/t(2) - u_out%Un_disk = u1%Un_disk + b0 * t_out - b0 = -(u1%R_disk - u2%R_disk)/t(2) - u_out%R_disk = u1%R_disk + b0 * t_out - ALLOCATE(b1(SIZE(u_out%vind_s,1))) - ALLOCATE(c1(SIZE(u_out%vind_s,1))) - b1 = -(u1%vind_s - u2%vind_s)/t(2) - u_out%vind_s = u1%vind_s + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - b0 = -(u1%spanRatio - u2%spanRatio)/t(2) - u_out%spanRatio = u1%spanRatio + b0 * t_out + + ScaleFactor = t_out / t(2) + b = -(u1%AxInd_disk - u2%AxInd_disk) + u_out%AxInd_disk = u1%AxInd_disk + b * ScaleFactor + b = -(u1%Un_disk - u2%Un_disk) + u_out%Un_disk = u1%Un_disk + b * ScaleFactor + b = -(u1%R_disk - u2%R_disk) + u_out%R_disk = u1%R_disk + b * ScaleFactor + DO i1 = LBOUND(u_out%vind_s,1),UBOUND(u_out%vind_s,1) + b = -(u1%vind_s(i1) - u2%vind_s(i1)) + u_out%vind_s(i1) = u1%vind_s(i1) + b * ScaleFactor + END DO + b = -(u1%spanRatio - u2%spanRatio) + u_out%spanRatio = u1%spanRatio + b * ScaleFactor END SUBROUTINE DBEMT_Input_ExtrapInterp1 @@ -2245,13 +2201,14 @@ SUBROUTINE DBEMT_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, E REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -2270,25 +2227,25 @@ SUBROUTINE DBEMT_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, E CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - b0 = (t(3)**2*(u1%AxInd_disk - u2%AxInd_disk) + t(2)**2*(-u1%AxInd_disk + u3%AxInd_disk))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%AxInd_disk + t(3)*u2%AxInd_disk - t(2)*u3%AxInd_disk ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%AxInd_disk = u1%AxInd_disk + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%Un_disk - u2%Un_disk) + t(2)**2*(-u1%Un_disk + u3%Un_disk))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%Un_disk + t(3)*u2%Un_disk - t(2)*u3%Un_disk ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Un_disk = u1%Un_disk + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%R_disk - u2%R_disk) + t(2)**2*(-u1%R_disk + u3%R_disk))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%R_disk + t(3)*u2%R_disk - t(2)*u3%R_disk ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%R_disk = u1%R_disk + b0 * t_out + c0 * t_out**2 - ALLOCATE(b1(SIZE(u_out%vind_s,1))) - ALLOCATE(c1(SIZE(u_out%vind_s,1))) - b1 = (t(3)**2*(u1%vind_s - u2%vind_s) + t(2)**2*(-u1%vind_s + u3%vind_s))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%vind_s + t(3)*u2%vind_s - t(2)*u3%vind_s ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%vind_s = u1%vind_s + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - b0 = (t(3)**2*(u1%spanRatio - u2%spanRatio) + t(2)**2*(-u1%spanRatio + u3%spanRatio))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%spanRatio + t(3)*u2%spanRatio - t(2)*u3%spanRatio ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%spanRatio = u1%spanRatio + b0 * t_out + c0 * t_out**2 + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) + b = (t(3)**2*(u1%AxInd_disk - u2%AxInd_disk) + t(2)**2*(-u1%AxInd_disk + u3%AxInd_disk))* scaleFactor + c = ( (t(2)-t(3))*u1%AxInd_disk + t(3)*u2%AxInd_disk - t(2)*u3%AxInd_disk ) * scaleFactor + u_out%AxInd_disk = u1%AxInd_disk + b + c * t_out + b = (t(3)**2*(u1%Un_disk - u2%Un_disk) + t(2)**2*(-u1%Un_disk + u3%Un_disk))* scaleFactor + c = ( (t(2)-t(3))*u1%Un_disk + t(3)*u2%Un_disk - t(2)*u3%Un_disk ) * scaleFactor + u_out%Un_disk = u1%Un_disk + b + c * t_out + b = (t(3)**2*(u1%R_disk - u2%R_disk) + t(2)**2*(-u1%R_disk + u3%R_disk))* scaleFactor + c = ( (t(2)-t(3))*u1%R_disk + t(3)*u2%R_disk - t(2)*u3%R_disk ) * scaleFactor + u_out%R_disk = u1%R_disk + b + c * t_out + DO i1 = LBOUND(u_out%vind_s,1),UBOUND(u_out%vind_s,1) + b = (t(3)**2*(u1%vind_s(i1) - u2%vind_s(i1)) + t(2)**2*(-u1%vind_s(i1) + u3%vind_s(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%vind_s(i1) + t(3)*u2%vind_s(i1) - t(2)*u3%vind_s(i1) ) * scaleFactor + u_out%vind_s(i1) = u1%vind_s(i1) + b + c * t_out + END DO + b = (t(3)**2*(u1%spanRatio - u2%spanRatio) + t(2)**2*(-u1%spanRatio + u3%spanRatio))* scaleFactor + c = ( (t(2)-t(3))*u1%spanRatio + t(3)*u2%spanRatio - t(2)*u3%spanRatio ) * scaleFactor + u_out%spanRatio = u1%spanRatio + b + c * t_out END SUBROUTINE DBEMT_Input_ExtrapInterp2 @@ -2366,16 +2323,16 @@ SUBROUTINE DBEMT_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrM REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: b3 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: c3 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + INTEGER :: i3 ! dim3 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -2388,15 +2345,17 @@ SUBROUTINE DBEMT_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) IF (ALLOCATED(y_out%vind) .AND. ALLOCATED(y1%vind)) THEN - ALLOCATE(b3(SIZE(y_out%vind,1),SIZE(y_out%vind,2), & - SIZE(y_out%vind,3) )) - ALLOCATE(c3(SIZE(y_out%vind,1),SIZE(y_out%vind,2), & - SIZE(y_out%vind,3) )) - b3 = -(y1%vind - y2%vind)/t(2) - y_out%vind = y1%vind + b3 * t_out - DEALLOCATE(b3) - DEALLOCATE(c3) + DO i3 = LBOUND(y_out%vind,3),UBOUND(y_out%vind,3) + DO i2 = LBOUND(y_out%vind,2),UBOUND(y_out%vind,2) + DO i1 = LBOUND(y_out%vind,1),UBOUND(y_out%vind,1) + b = -(y1%vind(i1,i2,i3) - y2%vind(i1,i2,i3)) + y_out%vind(i1,i2,i3) = y1%vind(i1,i2,i3) + b * ScaleFactor + END DO + END DO + END DO END IF ! check if allocated END SUBROUTINE DBEMT_Output_ExtrapInterp1 @@ -2427,17 +2386,18 @@ SUBROUTINE DBEMT_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: b3 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: c3 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'DBEMT_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + INTEGER :: i3 ! dim3 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -2456,16 +2416,18 @@ SUBROUTINE DBEMT_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) IF (ALLOCATED(y_out%vind) .AND. ALLOCATED(y1%vind)) THEN - ALLOCATE(b3(SIZE(y_out%vind,1),SIZE(y_out%vind,2), & - SIZE(y_out%vind,3) )) - ALLOCATE(c3(SIZE(y_out%vind,1),SIZE(y_out%vind,2), & - SIZE(y_out%vind,3) )) - b3 = (t(3)**2*(y1%vind - y2%vind) + t(2)**2*(-y1%vind + y3%vind))/(t(2)*t(3)*(t(2) - t(3))) - c3 = ( (t(2)-t(3))*y1%vind + t(3)*y2%vind - t(2)*y3%vind ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%vind = y1%vind + b3 * t_out + c3 * t_out**2 - DEALLOCATE(b3) - DEALLOCATE(c3) + DO i3 = LBOUND(y_out%vind,3),UBOUND(y_out%vind,3) + DO i2 = LBOUND(y_out%vind,2),UBOUND(y_out%vind,2) + DO i1 = LBOUND(y_out%vind,1),UBOUND(y_out%vind,1) + b = (t(3)**2*(y1%vind(i1,i2,i3) - y2%vind(i1,i2,i3)) + t(2)**2*(-y1%vind(i1,i2,i3) + y3%vind(i1,i2,i3)))* scaleFactor + c = ( (t(2)-t(3))*y1%vind(i1,i2,i3) + t(3)*y2%vind(i1,i2,i3) - t(2)*y3%vind(i1,i2,i3) ) * scaleFactor + y_out%vind(i1,i2,i3) = y1%vind(i1,i2,i3) + b + c * t_out + END DO + END DO + END DO END IF ! check if allocated END SUBROUTINE DBEMT_Output_ExtrapInterp2 diff --git a/modules/aerodyn/src/UnsteadyAero.f90 b/modules/aerodyn/src/UnsteadyAero.f90 index 04efb0fb11..c85b2ceeda 100644 --- a/modules/aerodyn/src/UnsteadyAero.f90 +++ b/modules/aerodyn/src/UnsteadyAero.f90 @@ -29,7 +29,6 @@ module UnsteadyAero implicit none private - type(ProgDesc), parameter :: UA_Ver = ProgDesc( 'UnsteadyAero', '', '' ) public :: UA_Init public :: UA_UpdateDiscOtherState @@ -43,7 +42,7 @@ module UnsteadyAero integer(intki), parameter :: UA_Baseline = 1 ! UAMod = 1 [Baseline model (Original)] integer(intki), parameter :: UA_Gonzalez = 2 ! UAMod = 2 [Gonzalez's variant (changes in Cn,Cc,Cm)] - integer(intki), parameter :: UA_MinemmaPierce = 3 ! UAMod = 3 [Minemma/Pierce variant (changes in Cc and Cm)] + integer(intki), parameter :: UA_MinnemaPierce = 3 ! UAMod = 3 [Minnema/Pierce variant (changes in Cc and Cm)] real(ReKi), parameter :: Gonzalez_factor = 0.2_ReKi ! this factor, proposed by Gonzalez (for "all" models) is used to modify Cc to account for negative values seen at f=0 (see Eqn 1.40) @@ -523,7 +522,7 @@ subroutine ComputeKelvinChain( i, j, u, p, xd, OtherState, misc, AFInfo, KC, BL_ Kprimeprime_q = Get_ExpEqn( real(p%dt,ReKi), k_mq**2*T_I , xd%Kprimeprime_q_minus1(i,j) , KC%Kq_f , Kq_f_minus1 ) ! Eqn 1.29 [3] ! Compute Cm_q_nc - if ( p%UAMod == UA_MinemmaPierce ) then + if ( p%UAMod == UA_MinnemaPierce ) then KC%Cm_q_nc = -1.0_ReKi * KC%Cn_q_nc / 4.0_ReKi - (KC%k_alpha**2) * T_I * (KC%Kq_f - Kprimeprime_q) / (3.0_ReKi*M) ! Eqn 1.31 else KC%Cm_q_nc = -7.0_ReKi * (k_mq**2) * T_I * (KC%Kq_f - Kprimeprime_q) / (12.0_ReKi*M) ! Eqn 1.29 [1] @@ -644,7 +643,7 @@ subroutine ComputeKelvinChain( i, j, u, p, xd, OtherState, misc, AFInfo, KC, BL_ end if - if ( p%UAMod == UA_MinemmaPierce ) then + if ( p%UAMod == UA_MinnemaPierce ) then if (OtherState%FirstPass(i,j)) then KC%Dalphaf = 0.0_ReKi else @@ -699,11 +698,11 @@ subroutine UA_SetParameters( dt, InitInp, p, ErrStat, ErrMsg ) ! Calls to : NONE !.............................................................................. - real(DbKi), intent(inout) :: dt ! time step length (s) + real(DbKi), intent(in ) :: dt ! time step length (s) type(UA_InitInputType), intent(inout) :: InitInp ! input data for initialization routine, needs to be inout because there is a copy of some data in InitInp in BEMT_SetParameters() type(UA_ParameterType), intent(inout) :: p ! parameters - integer(IntKi), intent( out) :: ErrStat ! error status of the operation - character(*), intent( out) :: ErrMsg ! error message if ErrStat /= ErrID_None + integer(IntKi), intent( out) :: ErrStat ! error status of the operation + character(*), intent( out) :: ErrMsg ! error message if ErrStat /= ErrID_None integer(IntKi) :: ErrStat2 character(*), parameter :: RoutineName = 'UA_SetParameters' @@ -887,7 +886,7 @@ subroutine UA_Init( InitInp, u, p, xd, OtherState, y, m, Interval, & type(UA_OutputType), intent( out) :: y ! Initial system outputs (outputs are not calculated; ! only the output mesh is initialized) type(UA_MiscVarType), intent( out) :: m ! Initial misc/optimization variables - real(DbKi), intent(inout) :: interval ! Coupling interval in seconds: the rate that + real(DbKi), intent(in ) :: interval ! Coupling interval in seconds: the rate that ! (1) BEMT_UpdateStates() is called in loose coupling & ! (2) BEMT_UpdateDiscState() is called in tight coupling. ! Input is the suggested time from the glue code; @@ -916,9 +915,6 @@ subroutine UA_Init( InitInp, u, p, xd, OtherState, y, m, Interval, & ! Initialize the NWTC Subroutine Library call NWTC_Init( EchoLibVer=.FALSE. ) - ! Display the module information - call DispNVD( UA_Ver ) - call UA_ValidateInput(InitInp, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -1063,8 +1059,8 @@ subroutine UA_ValidateInput(InitInp, ErrStat, ErrMsg) ErrStat = ErrID_None ErrMsg = "" - if (InitInp%UAMod < UA_Gonzalez .or. InitInp%UAMod > UA_MinemmaPierce ) call SetErrStat( ErrID_Fatal, & - "In this version, UAMod must be 2 (Gonzalez's variant) or 3 (Minemma/Pierce variant).", ErrStat, ErrMsg, RoutineName ) ! NOTE: for later- 1 (baseline/original) + if (InitInp%UAMod < UA_Gonzalez .or. InitInp%UAMod > UA_MinnemaPierce ) call SetErrStat( ErrID_Fatal, & + "In this version, UAMod must be 2 (Gonzalez's variant) or 3 (Minnema/Pierce variant).", ErrStat, ErrMsg, RoutineName ) ! NOTE: for later- 1 (baseline/original) if (.not. InitInp%FLookUp ) call SetErrStat( ErrID_Fatal, 'FLookUp must be TRUE for this version.', ErrStat, ErrMsg, RoutineName ) @@ -1629,7 +1625,7 @@ subroutine UA_CalcOutput( u, p, xd, OtherState, AFInfo, y, misc, ErrStat, ErrMsg end if - if ( p%UAMod == UA_MinemmaPierce ) then + if ( p%UAMod == UA_MinnemaPierce ) then #ifdef TEST_THEORY y%Cc = Cc_FS + KC%Cn_v*tan(KC%alpha_e)*(1-xd%tau_v(misc%iBladeNode, misc%iBlade)/(BL_p%T_VL)) ! Eqn 1.55 with Eqn. 1.40 #else @@ -1715,7 +1711,7 @@ subroutine UA_CalcOutput( u, p, xd, OtherState, AFInfo, y, misc, ErrStat, ErrMsg x_cp_hat = BL_p%k0 + BL_p%k1*(1.0_ReKi-KC%fprimeprime) + BL_p%k2*sin(pi*KC%fprimeprime**BL_p%k3) ! Eqn 1.42 Cm_FS = BL_p%Cm0 - KC%Cn_alpha_q_circ*(x_cp_hat - 0.25_ReKi) + Cm_common ! Eqn 1.41 - elseif ( p%UAMod == UA_MinemmaPierce ) then + elseif ( p%UAMod == UA_MinnemaPierce ) then ! Look up Cm using alpha_prime_f alpha_prime_f = KC%alpha_f - KC%Dalphaf ! Eqn 1.43a diff --git a/modules/aerodyn/src/UnsteadyAero_Types.f90 b/modules/aerodyn/src/UnsteadyAero_Types.f90 index ffe61ed6b8..6e79d82c90 100644 --- a/modules/aerodyn/src/UnsteadyAero_Types.f90 +++ b/modules/aerodyn/src/UnsteadyAero_Types.f90 @@ -339,12 +339,12 @@ SUBROUTINE UA_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%dt - Db_Xferred = Db_Xferred + 1 - DO I = 1, LEN(InData%OutRootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutRootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DbKiBuf(Db_Xferred) = InData%dt + Db_Xferred = Db_Xferred + 1 + DO I = 1, LEN(InData%OutRootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutRootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( .NOT. ALLOCATED(InData%c) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -358,21 +358,25 @@ SUBROUTINE UA_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%c,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%c)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%c))-1 ) = PACK(InData%c,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%c) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%numBlades - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%nNodesPerBlade - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UAMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%a_s - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Flookup , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(InData%c,2), UBOUND(InData%c,2) + DO i1 = LBOUND(InData%c,1), UBOUND(InData%c,1) + ReKiBuf(Re_Xferred) = InData%c(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IntKiBuf(Int_Xferred) = InData%numBlades + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nNodesPerBlade + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%UAMod + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%a_s + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%Flookup, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 END SUBROUTINE UA_PackInitInput SUBROUTINE UA_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -388,12 +392,6 @@ SUBROUTINE UA_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -409,12 +407,12 @@ SUBROUTINE UA_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%dt = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - DO I = 1, LEN(OutData%OutRootName) - OutData%OutRootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + OutData%dt = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + DO I = 1, LEN(OutData%OutRootName) + OutData%OutRootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! c not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -431,28 +429,25 @@ SUBROUTINE UA_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%c.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%c)>0) OutData%c = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%c))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%c) - DEALLOCATE(mask2) - END IF - OutData%numBlades = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%nNodesPerBlade = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%UAMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%a_s = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Flookup = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(OutData%c,2), UBOUND(OutData%c,2) + DO i1 = LBOUND(OutData%c,1), UBOUND(OutData%c,1) + OutData%c(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%numBlades = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nNodesPerBlade = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%UAMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%a_s = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Flookup = TRANSFER(IntKiBuf(Int_Xferred), OutData%Flookup) + Int_Xferred = Int_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE UA_UnPackInitInput SUBROUTINE UA_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -645,12 +640,12 @@ SUBROUTINE UA_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -662,12 +657,12 @@ SUBROUTINE UA_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF END SUBROUTINE UA_PackInitOutput @@ -684,12 +679,6 @@ SUBROUTINE UA_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -757,19 +746,12 @@ SUBROUTINE UA_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated Int_Xferred = Int_Xferred + 1 @@ -784,19 +766,12 @@ SUBROUTINE UA_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF END SUBROUTINE UA_UnPackInitOutput @@ -987,104 +962,104 @@ SUBROUTINE UA_PackKelvinChainType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cn_prime - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%C_nalpha_circ - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Kalpha_f - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Kq_f - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%alpha_filt_cur - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%alpha_e - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dalpha0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%alpha_f - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Kq - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%q_cur - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%q_f_cur - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%X1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%X2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%X3 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%X4 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Kprime_alpha - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Kprime_q - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Dp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cn_pot - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cc_pot - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cn_alpha_q_circ - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cn_alpha_q_nc - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cm_q_circ - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cn_alpha_nc - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cn_q_circ - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cn_q_nc - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cm_q_nc - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%fprimeprime - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Df - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Df_c - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Df_m - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Dalphaf - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%fprime - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%fprime_c - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%fprimeprime_c - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%fprime_m - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%fprimeprime_m - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cn_v - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%C_V - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cn_FS - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%T_f - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%T_fc - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%T_fm - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%T_V - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%k_alpha - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%k_q - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%T_alpha - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%T_q - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ds - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cn_prime + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%C_nalpha_circ + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Kalpha_f + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Kq_f + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%alpha_filt_cur + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%alpha_e + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%dalpha0 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%alpha_f + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Kq + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%q_cur + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%q_f_cur + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%X1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%X2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%X3 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%X4 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Kprime_alpha + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Kprime_q + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Dp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cn_pot + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cc_pot + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cn_alpha_q_circ + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cn_alpha_q_nc + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cm_q_circ + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cn_alpha_nc + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cn_q_circ + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cn_q_nc + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cm_q_nc + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%fprimeprime + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Df + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Df_c + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Df_m + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Dalphaf + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%fprime + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%fprime_c + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%fprimeprime_c + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%fprime_m + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%fprimeprime_m + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cn_v + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%C_V + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cn_FS + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%T_f + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%T_fc + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%T_fm + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%T_V + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k_alpha + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%k_q + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%T_alpha + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%T_q + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%ds + Re_Xferred = Re_Xferred + 1 END SUBROUTINE UA_PackKelvinChainType SUBROUTINE UA_UnPackKelvinChainType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1100,12 +1075,6 @@ SUBROUTINE UA_UnPackKelvinChainType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'UA_UnPackKelvinChainType' @@ -1119,104 +1088,104 @@ SUBROUTINE UA_UnPackKelvinChainType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%Cn_prime = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%C_nalpha_circ = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Kalpha_f = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Kq_f = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%alpha_filt_cur = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%alpha_e = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%dalpha0 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%alpha_f = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Kq = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%q_cur = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%q_f_cur = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%X1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%X2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%X3 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%X4 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Kprime_alpha = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Kprime_q = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Dp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cn_pot = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cc_pot = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cn_alpha_q_circ = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cn_alpha_q_nc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cm_q_circ = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cn_alpha_nc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cn_q_circ = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cn_q_nc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cm_q_nc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%fprimeprime = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Df = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Df_c = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Df_m = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Dalphaf = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%fprime = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%fprime_c = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%fprimeprime_c = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%fprime_m = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%fprimeprime_m = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cn_v = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%C_V = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cn_FS = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%T_f = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%T_fc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%T_fm = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%T_V = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%k_alpha = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%k_q = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%T_alpha = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%T_q = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%ds = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%Cn_prime = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%C_nalpha_circ = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Kalpha_f = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Kq_f = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%alpha_filt_cur = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%alpha_e = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%dalpha0 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%alpha_f = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Kq = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%q_cur = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%q_f_cur = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%X1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%X2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%X3 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%X4 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Kprime_alpha = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Kprime_q = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Dp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cn_pot = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cc_pot = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cn_alpha_q_circ = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cn_alpha_q_nc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cm_q_circ = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cn_alpha_nc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cn_q_circ = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cn_q_nc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cm_q_nc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%fprimeprime = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Df = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Df_c = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Df_m = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Dalphaf = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%fprime = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%fprime_c = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%fprimeprime_c = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%fprime_m = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%fprimeprime_m = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cn_v = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%C_V = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cn_FS = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%T_f = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%T_fc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%T_fm = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%T_V = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%k_alpha = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%k_q = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%T_alpha = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%T_q = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%ds = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE UA_UnPackKelvinChainType SUBROUTINE UA_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) @@ -1310,8 +1279,8 @@ SUBROUTINE UA_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyContState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyContState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE UA_PackContState SUBROUTINE UA_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1327,12 +1296,6 @@ SUBROUTINE UA_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'UA_UnPackContState' @@ -1346,8 +1309,8 @@ SUBROUTINE UA_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyContState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyContState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE UA_UnPackContState SUBROUTINE UA_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) @@ -2158,8 +2121,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%alpha_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%alpha_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%alpha_minus1))-1 ) = PACK(InData%alpha_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%alpha_minus1) + DO i2 = LBOUND(InData%alpha_minus1,2), UBOUND(InData%alpha_minus1,2) + DO i1 = LBOUND(InData%alpha_minus1,1), UBOUND(InData%alpha_minus1,1) + ReKiBuf(Re_Xferred) = InData%alpha_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%alpha_filt_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2174,8 +2141,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%alpha_filt_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%alpha_filt_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%alpha_filt_minus1))-1 ) = PACK(InData%alpha_filt_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%alpha_filt_minus1) + DO i2 = LBOUND(InData%alpha_filt_minus1,2), UBOUND(InData%alpha_filt_minus1,2) + DO i1 = LBOUND(InData%alpha_filt_minus1,1), UBOUND(InData%alpha_filt_minus1,1) + ReKiBuf(Re_Xferred) = InData%alpha_filt_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%q_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2190,8 +2161,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%q_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%q_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%q_minus1))-1 ) = PACK(InData%q_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%q_minus1) + DO i2 = LBOUND(InData%q_minus1,2), UBOUND(InData%q_minus1,2) + DO i1 = LBOUND(InData%q_minus1,1), UBOUND(InData%q_minus1,1) + ReKiBuf(Re_Xferred) = InData%q_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Kalpha_f_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2206,8 +2181,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Kalpha_f_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Kalpha_f_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Kalpha_f_minus1))-1 ) = PACK(InData%Kalpha_f_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Kalpha_f_minus1) + DO i2 = LBOUND(InData%Kalpha_f_minus1,2), UBOUND(InData%Kalpha_f_minus1,2) + DO i1 = LBOUND(InData%Kalpha_f_minus1,1), UBOUND(InData%Kalpha_f_minus1,1) + ReKiBuf(Re_Xferred) = InData%Kalpha_f_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Kq_f_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2222,8 +2201,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Kq_f_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Kq_f_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Kq_f_minus1))-1 ) = PACK(InData%Kq_f_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Kq_f_minus1) + DO i2 = LBOUND(InData%Kq_f_minus1,2), UBOUND(InData%Kq_f_minus1,2) + DO i1 = LBOUND(InData%Kq_f_minus1,1), UBOUND(InData%Kq_f_minus1,1) + ReKiBuf(Re_Xferred) = InData%Kq_f_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%q_f_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2238,8 +2221,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%q_f_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%q_f_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%q_f_minus1))-1 ) = PACK(InData%q_f_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%q_f_minus1) + DO i2 = LBOUND(InData%q_f_minus1,2), UBOUND(InData%q_f_minus1,2) + DO i1 = LBOUND(InData%q_f_minus1,1), UBOUND(InData%q_f_minus1,1) + ReKiBuf(Re_Xferred) = InData%q_f_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%X1_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2254,8 +2241,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%X1_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%X1_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%X1_minus1))-1 ) = PACK(InData%X1_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%X1_minus1) + DO i2 = LBOUND(InData%X1_minus1,2), UBOUND(InData%X1_minus1,2) + DO i1 = LBOUND(InData%X1_minus1,1), UBOUND(InData%X1_minus1,1) + ReKiBuf(Re_Xferred) = InData%X1_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%X2_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2270,8 +2261,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%X2_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%X2_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%X2_minus1))-1 ) = PACK(InData%X2_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%X2_minus1) + DO i2 = LBOUND(InData%X2_minus1,2), UBOUND(InData%X2_minus1,2) + DO i1 = LBOUND(InData%X2_minus1,1), UBOUND(InData%X2_minus1,1) + ReKiBuf(Re_Xferred) = InData%X2_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%X3_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2286,8 +2281,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%X3_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%X3_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%X3_minus1))-1 ) = PACK(InData%X3_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%X3_minus1) + DO i2 = LBOUND(InData%X3_minus1,2), UBOUND(InData%X3_minus1,2) + DO i1 = LBOUND(InData%X3_minus1,1), UBOUND(InData%X3_minus1,1) + ReKiBuf(Re_Xferred) = InData%X3_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%X4_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2302,8 +2301,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%X4_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%X4_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%X4_minus1))-1 ) = PACK(InData%X4_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%X4_minus1) + DO i2 = LBOUND(InData%X4_minus1,2), UBOUND(InData%X4_minus1,2) + DO i1 = LBOUND(InData%X4_minus1,1), UBOUND(InData%X4_minus1,1) + ReKiBuf(Re_Xferred) = InData%X4_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Kprime_alpha_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2318,8 +2321,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Kprime_alpha_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Kprime_alpha_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Kprime_alpha_minus1))-1 ) = PACK(InData%Kprime_alpha_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Kprime_alpha_minus1) + DO i2 = LBOUND(InData%Kprime_alpha_minus1,2), UBOUND(InData%Kprime_alpha_minus1,2) + DO i1 = LBOUND(InData%Kprime_alpha_minus1,1), UBOUND(InData%Kprime_alpha_minus1,1) + ReKiBuf(Re_Xferred) = InData%Kprime_alpha_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Kprime_q_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2334,8 +2341,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Kprime_q_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Kprime_q_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Kprime_q_minus1))-1 ) = PACK(InData%Kprime_q_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Kprime_q_minus1) + DO i2 = LBOUND(InData%Kprime_q_minus1,2), UBOUND(InData%Kprime_q_minus1,2) + DO i1 = LBOUND(InData%Kprime_q_minus1,1), UBOUND(InData%Kprime_q_minus1,1) + ReKiBuf(Re_Xferred) = InData%Kprime_q_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Kprimeprime_q_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2350,8 +2361,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Kprimeprime_q_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Kprimeprime_q_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Kprimeprime_q_minus1))-1 ) = PACK(InData%Kprimeprime_q_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Kprimeprime_q_minus1) + DO i2 = LBOUND(InData%Kprimeprime_q_minus1,2), UBOUND(InData%Kprimeprime_q_minus1,2) + DO i1 = LBOUND(InData%Kprimeprime_q_minus1,1), UBOUND(InData%Kprimeprime_q_minus1,1) + ReKiBuf(Re_Xferred) = InData%Kprimeprime_q_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%K3prime_q_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2366,8 +2381,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%K3prime_q_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%K3prime_q_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%K3prime_q_minus1))-1 ) = PACK(InData%K3prime_q_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%K3prime_q_minus1) + DO i2 = LBOUND(InData%K3prime_q_minus1,2), UBOUND(InData%K3prime_q_minus1,2) + DO i1 = LBOUND(InData%K3prime_q_minus1,1), UBOUND(InData%K3prime_q_minus1,1) + ReKiBuf(Re_Xferred) = InData%K3prime_q_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Dp_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2382,8 +2401,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Dp_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Dp_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Dp_minus1))-1 ) = PACK(InData%Dp_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Dp_minus1) + DO i2 = LBOUND(InData%Dp_minus1,2), UBOUND(InData%Dp_minus1,2) + DO i1 = LBOUND(InData%Dp_minus1,1), UBOUND(InData%Dp_minus1,1) + ReKiBuf(Re_Xferred) = InData%Dp_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Cn_pot_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2398,8 +2421,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cn_pot_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Cn_pot_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Cn_pot_minus1))-1 ) = PACK(InData%Cn_pot_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Cn_pot_minus1) + DO i2 = LBOUND(InData%Cn_pot_minus1,2), UBOUND(InData%Cn_pot_minus1,2) + DO i1 = LBOUND(InData%Cn_pot_minus1,1), UBOUND(InData%Cn_pot_minus1,1) + ReKiBuf(Re_Xferred) = InData%Cn_pot_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%fprimeprime_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2414,8 +2441,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fprimeprime_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%fprimeprime_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%fprimeprime_minus1))-1 ) = PACK(InData%fprimeprime_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%fprimeprime_minus1) + DO i2 = LBOUND(InData%fprimeprime_minus1,2), UBOUND(InData%fprimeprime_minus1,2) + DO i1 = LBOUND(InData%fprimeprime_minus1,1), UBOUND(InData%fprimeprime_minus1,1) + ReKiBuf(Re_Xferred) = InData%fprimeprime_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%fprimeprime_c_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2430,8 +2461,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fprimeprime_c_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%fprimeprime_c_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%fprimeprime_c_minus1))-1 ) = PACK(InData%fprimeprime_c_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%fprimeprime_c_minus1) + DO i2 = LBOUND(InData%fprimeprime_c_minus1,2), UBOUND(InData%fprimeprime_c_minus1,2) + DO i1 = LBOUND(InData%fprimeprime_c_minus1,1), UBOUND(InData%fprimeprime_c_minus1,1) + ReKiBuf(Re_Xferred) = InData%fprimeprime_c_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%fprimeprime_m_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2446,8 +2481,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fprimeprime_m_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%fprimeprime_m_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%fprimeprime_m_minus1))-1 ) = PACK(InData%fprimeprime_m_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%fprimeprime_m_minus1) + DO i2 = LBOUND(InData%fprimeprime_m_minus1,2), UBOUND(InData%fprimeprime_m_minus1,2) + DO i1 = LBOUND(InData%fprimeprime_m_minus1,1), UBOUND(InData%fprimeprime_m_minus1,1) + ReKiBuf(Re_Xferred) = InData%fprimeprime_m_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Df_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2462,8 +2501,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Df_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Df_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Df_minus1))-1 ) = PACK(InData%Df_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Df_minus1) + DO i2 = LBOUND(InData%Df_minus1,2), UBOUND(InData%Df_minus1,2) + DO i1 = LBOUND(InData%Df_minus1,1), UBOUND(InData%Df_minus1,1) + ReKiBuf(Re_Xferred) = InData%Df_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Df_c_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2478,8 +2521,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Df_c_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Df_c_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Df_c_minus1))-1 ) = PACK(InData%Df_c_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Df_c_minus1) + DO i2 = LBOUND(InData%Df_c_minus1,2), UBOUND(InData%Df_c_minus1,2) + DO i1 = LBOUND(InData%Df_c_minus1,1), UBOUND(InData%Df_c_minus1,1) + ReKiBuf(Re_Xferred) = InData%Df_c_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Df_m_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2494,8 +2541,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Df_m_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Df_m_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Df_m_minus1))-1 ) = PACK(InData%Df_m_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Df_m_minus1) + DO i2 = LBOUND(InData%Df_m_minus1,2), UBOUND(InData%Df_m_minus1,2) + DO i1 = LBOUND(InData%Df_m_minus1,1), UBOUND(InData%Df_m_minus1,1) + ReKiBuf(Re_Xferred) = InData%Df_m_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Dalphaf_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2510,8 +2561,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Dalphaf_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Dalphaf_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Dalphaf_minus1))-1 ) = PACK(InData%Dalphaf_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Dalphaf_minus1) + DO i2 = LBOUND(InData%Dalphaf_minus1,2), UBOUND(InData%Dalphaf_minus1,2) + DO i1 = LBOUND(InData%Dalphaf_minus1,1), UBOUND(InData%Dalphaf_minus1,1) + ReKiBuf(Re_Xferred) = InData%Dalphaf_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%alphaf_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2526,8 +2581,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%alphaf_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%alphaf_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%alphaf_minus1))-1 ) = PACK(InData%alphaf_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%alphaf_minus1) + DO i2 = LBOUND(InData%alphaf_minus1,2), UBOUND(InData%alphaf_minus1,2) + DO i1 = LBOUND(InData%alphaf_minus1,1), UBOUND(InData%alphaf_minus1,1) + ReKiBuf(Re_Xferred) = InData%alphaf_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%fprime_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2542,8 +2601,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fprime_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%fprime_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%fprime_minus1))-1 ) = PACK(InData%fprime_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%fprime_minus1) + DO i2 = LBOUND(InData%fprime_minus1,2), UBOUND(InData%fprime_minus1,2) + DO i1 = LBOUND(InData%fprime_minus1,1), UBOUND(InData%fprime_minus1,1) + ReKiBuf(Re_Xferred) = InData%fprime_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%fprime_c_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2558,8 +2621,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fprime_c_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%fprime_c_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%fprime_c_minus1))-1 ) = PACK(InData%fprime_c_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%fprime_c_minus1) + DO i2 = LBOUND(InData%fprime_c_minus1,2), UBOUND(InData%fprime_c_minus1,2) + DO i1 = LBOUND(InData%fprime_c_minus1,1), UBOUND(InData%fprime_c_minus1,1) + ReKiBuf(Re_Xferred) = InData%fprime_c_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%fprime_m_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2574,8 +2641,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fprime_m_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%fprime_m_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%fprime_m_minus1))-1 ) = PACK(InData%fprime_m_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%fprime_m_minus1) + DO i2 = LBOUND(InData%fprime_m_minus1,2), UBOUND(InData%fprime_m_minus1,2) + DO i1 = LBOUND(InData%fprime_m_minus1,1), UBOUND(InData%fprime_m_minus1,1) + ReKiBuf(Re_Xferred) = InData%fprime_m_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%tau_V) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2590,8 +2661,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%tau_V,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%tau_V)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%tau_V))-1 ) = PACK(InData%tau_V,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%tau_V) + DO i2 = LBOUND(InData%tau_V,2), UBOUND(InData%tau_V,2) + DO i1 = LBOUND(InData%tau_V,1), UBOUND(InData%tau_V,1) + ReKiBuf(Re_Xferred) = InData%tau_V(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%tau_V_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2606,8 +2681,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%tau_V_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%tau_V_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%tau_V_minus1))-1 ) = PACK(InData%tau_V_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%tau_V_minus1) + DO i2 = LBOUND(InData%tau_V_minus1,2), UBOUND(InData%tau_V_minus1,2) + DO i1 = LBOUND(InData%tau_V_minus1,1), UBOUND(InData%tau_V_minus1,1) + ReKiBuf(Re_Xferred) = InData%tau_V_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Cn_v_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2622,8 +2701,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cn_v_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Cn_v_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Cn_v_minus1))-1 ) = PACK(InData%Cn_v_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Cn_v_minus1) + DO i2 = LBOUND(InData%Cn_v_minus1,2), UBOUND(InData%Cn_v_minus1,2) + DO i1 = LBOUND(InData%Cn_v_minus1,1), UBOUND(InData%Cn_v_minus1,1) + ReKiBuf(Re_Xferred) = InData%Cn_v_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%C_V_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2638,8 +2721,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C_V_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%C_V_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%C_V_minus1))-1 ) = PACK(InData%C_V_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%C_V_minus1) + DO i2 = LBOUND(InData%C_V_minus1,2), UBOUND(InData%C_V_minus1,2) + DO i1 = LBOUND(InData%C_V_minus1,1), UBOUND(InData%C_V_minus1,1) + ReKiBuf(Re_Xferred) = InData%C_V_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Cn_prime_minus1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2654,8 +2741,12 @@ SUBROUTINE UA_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Cn_prime_minus1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Cn_prime_minus1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Cn_prime_minus1))-1 ) = PACK(InData%Cn_prime_minus1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Cn_prime_minus1) + DO i2 = LBOUND(InData%Cn_prime_minus1,2), UBOUND(InData%Cn_prime_minus1,2) + DO i1 = LBOUND(InData%Cn_prime_minus1,1), UBOUND(InData%Cn_prime_minus1,1) + ReKiBuf(Re_Xferred) = InData%Cn_prime_minus1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE UA_PackDiscState @@ -2672,12 +2763,6 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -2709,15 +2794,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%alpha_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%alpha_minus1)>0) OutData%alpha_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%alpha_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%alpha_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%alpha_minus1,2), UBOUND(OutData%alpha_minus1,2) + DO i1 = LBOUND(OutData%alpha_minus1,1), UBOUND(OutData%alpha_minus1,1) + OutData%alpha_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! alpha_filt_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -2735,15 +2817,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%alpha_filt_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%alpha_filt_minus1)>0) OutData%alpha_filt_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%alpha_filt_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%alpha_filt_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%alpha_filt_minus1,2), UBOUND(OutData%alpha_filt_minus1,2) + DO i1 = LBOUND(OutData%alpha_filt_minus1,1), UBOUND(OutData%alpha_filt_minus1,1) + OutData%alpha_filt_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! q_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -2761,15 +2840,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%q_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%q_minus1)>0) OutData%q_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%q_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%q_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%q_minus1,2), UBOUND(OutData%q_minus1,2) + DO i1 = LBOUND(OutData%q_minus1,1), UBOUND(OutData%q_minus1,1) + OutData%q_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Kalpha_f_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -2787,15 +2863,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Kalpha_f_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Kalpha_f_minus1)>0) OutData%Kalpha_f_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Kalpha_f_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Kalpha_f_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Kalpha_f_minus1,2), UBOUND(OutData%Kalpha_f_minus1,2) + DO i1 = LBOUND(OutData%Kalpha_f_minus1,1), UBOUND(OutData%Kalpha_f_minus1,1) + OutData%Kalpha_f_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Kq_f_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -2813,15 +2886,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Kq_f_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Kq_f_minus1)>0) OutData%Kq_f_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Kq_f_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Kq_f_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Kq_f_minus1,2), UBOUND(OutData%Kq_f_minus1,2) + DO i1 = LBOUND(OutData%Kq_f_minus1,1), UBOUND(OutData%Kq_f_minus1,1) + OutData%Kq_f_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! q_f_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -2839,15 +2909,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%q_f_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%q_f_minus1)>0) OutData%q_f_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%q_f_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%q_f_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%q_f_minus1,2), UBOUND(OutData%q_f_minus1,2) + DO i1 = LBOUND(OutData%q_f_minus1,1), UBOUND(OutData%q_f_minus1,1) + OutData%q_f_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! X1_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -2865,15 +2932,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%X1_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%X1_minus1)>0) OutData%X1_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%X1_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%X1_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%X1_minus1,2), UBOUND(OutData%X1_minus1,2) + DO i1 = LBOUND(OutData%X1_minus1,1), UBOUND(OutData%X1_minus1,1) + OutData%X1_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! X2_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -2891,15 +2955,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%X2_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%X2_minus1)>0) OutData%X2_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%X2_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%X2_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%X2_minus1,2), UBOUND(OutData%X2_minus1,2) + DO i1 = LBOUND(OutData%X2_minus1,1), UBOUND(OutData%X2_minus1,1) + OutData%X2_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! X3_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -2917,15 +2978,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%X3_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%X3_minus1)>0) OutData%X3_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%X3_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%X3_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%X3_minus1,2), UBOUND(OutData%X3_minus1,2) + DO i1 = LBOUND(OutData%X3_minus1,1), UBOUND(OutData%X3_minus1,1) + OutData%X3_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! X4_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -2943,15 +3001,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%X4_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%X4_minus1)>0) OutData%X4_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%X4_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%X4_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%X4_minus1,2), UBOUND(OutData%X4_minus1,2) + DO i1 = LBOUND(OutData%X4_minus1,1), UBOUND(OutData%X4_minus1,1) + OutData%X4_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Kprime_alpha_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -2969,15 +3024,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Kprime_alpha_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Kprime_alpha_minus1)>0) OutData%Kprime_alpha_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Kprime_alpha_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Kprime_alpha_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Kprime_alpha_minus1,2), UBOUND(OutData%Kprime_alpha_minus1,2) + DO i1 = LBOUND(OutData%Kprime_alpha_minus1,1), UBOUND(OutData%Kprime_alpha_minus1,1) + OutData%Kprime_alpha_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Kprime_q_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -2995,15 +3047,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Kprime_q_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Kprime_q_minus1)>0) OutData%Kprime_q_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Kprime_q_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Kprime_q_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Kprime_q_minus1,2), UBOUND(OutData%Kprime_q_minus1,2) + DO i1 = LBOUND(OutData%Kprime_q_minus1,1), UBOUND(OutData%Kprime_q_minus1,1) + OutData%Kprime_q_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Kprimeprime_q_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -3021,15 +3070,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Kprimeprime_q_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Kprimeprime_q_minus1)>0) OutData%Kprimeprime_q_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Kprimeprime_q_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Kprimeprime_q_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Kprimeprime_q_minus1,2), UBOUND(OutData%Kprimeprime_q_minus1,2) + DO i1 = LBOUND(OutData%Kprimeprime_q_minus1,1), UBOUND(OutData%Kprimeprime_q_minus1,1) + OutData%Kprimeprime_q_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! K3prime_q_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -3047,15 +3093,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%K3prime_q_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%K3prime_q_minus1)>0) OutData%K3prime_q_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%K3prime_q_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%K3prime_q_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%K3prime_q_minus1,2), UBOUND(OutData%K3prime_q_minus1,2) + DO i1 = LBOUND(OutData%K3prime_q_minus1,1), UBOUND(OutData%K3prime_q_minus1,1) + OutData%K3prime_q_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Dp_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -3073,15 +3116,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Dp_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Dp_minus1)>0) OutData%Dp_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Dp_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Dp_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Dp_minus1,2), UBOUND(OutData%Dp_minus1,2) + DO i1 = LBOUND(OutData%Dp_minus1,1), UBOUND(OutData%Dp_minus1,1) + OutData%Dp_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cn_pot_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -3099,15 +3139,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cn_pot_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Cn_pot_minus1)>0) OutData%Cn_pot_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Cn_pot_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Cn_pot_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Cn_pot_minus1,2), UBOUND(OutData%Cn_pot_minus1,2) + DO i1 = LBOUND(OutData%Cn_pot_minus1,1), UBOUND(OutData%Cn_pot_minus1,1) + OutData%Cn_pot_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fprimeprime_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -3125,15 +3162,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fprimeprime_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%fprimeprime_minus1)>0) OutData%fprimeprime_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%fprimeprime_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%fprimeprime_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%fprimeprime_minus1,2), UBOUND(OutData%fprimeprime_minus1,2) + DO i1 = LBOUND(OutData%fprimeprime_minus1,1), UBOUND(OutData%fprimeprime_minus1,1) + OutData%fprimeprime_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fprimeprime_c_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -3151,15 +3185,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fprimeprime_c_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%fprimeprime_c_minus1)>0) OutData%fprimeprime_c_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%fprimeprime_c_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%fprimeprime_c_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%fprimeprime_c_minus1,2), UBOUND(OutData%fprimeprime_c_minus1,2) + DO i1 = LBOUND(OutData%fprimeprime_c_minus1,1), UBOUND(OutData%fprimeprime_c_minus1,1) + OutData%fprimeprime_c_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fprimeprime_m_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -3177,15 +3208,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fprimeprime_m_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%fprimeprime_m_minus1)>0) OutData%fprimeprime_m_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%fprimeprime_m_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%fprimeprime_m_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%fprimeprime_m_minus1,2), UBOUND(OutData%fprimeprime_m_minus1,2) + DO i1 = LBOUND(OutData%fprimeprime_m_minus1,1), UBOUND(OutData%fprimeprime_m_minus1,1) + OutData%fprimeprime_m_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Df_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -3203,15 +3231,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Df_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Df_minus1)>0) OutData%Df_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Df_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Df_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Df_minus1,2), UBOUND(OutData%Df_minus1,2) + DO i1 = LBOUND(OutData%Df_minus1,1), UBOUND(OutData%Df_minus1,1) + OutData%Df_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Df_c_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -3229,15 +3254,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Df_c_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Df_c_minus1)>0) OutData%Df_c_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Df_c_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Df_c_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Df_c_minus1,2), UBOUND(OutData%Df_c_minus1,2) + DO i1 = LBOUND(OutData%Df_c_minus1,1), UBOUND(OutData%Df_c_minus1,1) + OutData%Df_c_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Df_m_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -3255,15 +3277,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Df_m_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Df_m_minus1)>0) OutData%Df_m_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Df_m_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Df_m_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Df_m_minus1,2), UBOUND(OutData%Df_m_minus1,2) + DO i1 = LBOUND(OutData%Df_m_minus1,1), UBOUND(OutData%Df_m_minus1,1) + OutData%Df_m_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Dalphaf_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -3281,15 +3300,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Dalphaf_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Dalphaf_minus1)>0) OutData%Dalphaf_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Dalphaf_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Dalphaf_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Dalphaf_minus1,2), UBOUND(OutData%Dalphaf_minus1,2) + DO i1 = LBOUND(OutData%Dalphaf_minus1,1), UBOUND(OutData%Dalphaf_minus1,1) + OutData%Dalphaf_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! alphaf_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -3307,15 +3323,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%alphaf_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%alphaf_minus1)>0) OutData%alphaf_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%alphaf_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%alphaf_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%alphaf_minus1,2), UBOUND(OutData%alphaf_minus1,2) + DO i1 = LBOUND(OutData%alphaf_minus1,1), UBOUND(OutData%alphaf_minus1,1) + OutData%alphaf_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fprime_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -3333,15 +3346,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fprime_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%fprime_minus1)>0) OutData%fprime_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%fprime_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%fprime_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%fprime_minus1,2), UBOUND(OutData%fprime_minus1,2) + DO i1 = LBOUND(OutData%fprime_minus1,1), UBOUND(OutData%fprime_minus1,1) + OutData%fprime_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fprime_c_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -3359,15 +3369,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fprime_c_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%fprime_c_minus1)>0) OutData%fprime_c_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%fprime_c_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%fprime_c_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%fprime_c_minus1,2), UBOUND(OutData%fprime_c_minus1,2) + DO i1 = LBOUND(OutData%fprime_c_minus1,1), UBOUND(OutData%fprime_c_minus1,1) + OutData%fprime_c_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fprime_m_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -3385,15 +3392,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fprime_m_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%fprime_m_minus1)>0) OutData%fprime_m_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%fprime_m_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%fprime_m_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%fprime_m_minus1,2), UBOUND(OutData%fprime_m_minus1,2) + DO i1 = LBOUND(OutData%fprime_m_minus1,1), UBOUND(OutData%fprime_m_minus1,1) + OutData%fprime_m_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! tau_V not allocated Int_Xferred = Int_Xferred + 1 @@ -3411,15 +3415,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%tau_V.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%tau_V)>0) OutData%tau_V = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%tau_V))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%tau_V) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%tau_V,2), UBOUND(OutData%tau_V,2) + DO i1 = LBOUND(OutData%tau_V,1), UBOUND(OutData%tau_V,1) + OutData%tau_V(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! tau_V_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -3437,15 +3438,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%tau_V_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%tau_V_minus1)>0) OutData%tau_V_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%tau_V_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%tau_V_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%tau_V_minus1,2), UBOUND(OutData%tau_V_minus1,2) + DO i1 = LBOUND(OutData%tau_V_minus1,1), UBOUND(OutData%tau_V_minus1,1) + OutData%tau_V_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cn_v_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -3463,15 +3461,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cn_v_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Cn_v_minus1)>0) OutData%Cn_v_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Cn_v_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Cn_v_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Cn_v_minus1,2), UBOUND(OutData%Cn_v_minus1,2) + DO i1 = LBOUND(OutData%Cn_v_minus1,1), UBOUND(OutData%Cn_v_minus1,1) + OutData%Cn_v_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C_V_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -3489,15 +3484,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C_V_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%C_V_minus1)>0) OutData%C_V_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%C_V_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%C_V_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%C_V_minus1,2), UBOUND(OutData%C_V_minus1,2) + DO i1 = LBOUND(OutData%C_V_minus1,1), UBOUND(OutData%C_V_minus1,1) + OutData%C_V_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Cn_prime_minus1 not allocated Int_Xferred = Int_Xferred + 1 @@ -3515,15 +3507,12 @@ SUBROUTINE UA_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Cn_prime_minus1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Cn_prime_minus1)>0) OutData%Cn_prime_minus1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Cn_prime_minus1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Cn_prime_minus1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Cn_prime_minus1,2), UBOUND(OutData%Cn_prime_minus1,2) + DO i1 = LBOUND(OutData%Cn_prime_minus1,1), UBOUND(OutData%Cn_prime_minus1,1) + OutData%Cn_prime_minus1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE UA_UnPackDiscState @@ -3618,8 +3607,8 @@ SUBROUTINE UA_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyConstraintState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyConstraintState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE UA_PackConstrState SUBROUTINE UA_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -3635,12 +3624,6 @@ SUBROUTINE UA_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'UA_UnPackConstrState' @@ -3654,8 +3637,8 @@ SUBROUTINE UA_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyConstraintState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyConstraintState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE UA_UnPackConstrState SUBROUTINE UA_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -3872,8 +3855,12 @@ SUBROUTINE UA_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FirstPass,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FirstPass)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%FirstPass)-1 ) = TRANSFER(PACK( InData%FirstPass ,.TRUE.), IntKiBuf(1), SIZE(InData%FirstPass)) - Int_Xferred = Int_Xferred + SIZE(InData%FirstPass) + DO i2 = LBOUND(InData%FirstPass,2), UBOUND(InData%FirstPass,2) + DO i1 = LBOUND(InData%FirstPass,1), UBOUND(InData%FirstPass,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%FirstPass(i1,i2), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%sigma1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3888,8 +3875,12 @@ SUBROUTINE UA_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%sigma1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%sigma1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%sigma1))-1 ) = PACK(InData%sigma1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%sigma1) + DO i2 = LBOUND(InData%sigma1,2), UBOUND(InData%sigma1,2) + DO i1 = LBOUND(InData%sigma1,1), UBOUND(InData%sigma1,1) + ReKiBuf(Re_Xferred) = InData%sigma1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%sigma1c) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3904,8 +3895,12 @@ SUBROUTINE UA_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%sigma1c,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%sigma1c)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%sigma1c))-1 ) = PACK(InData%sigma1c,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%sigma1c) + DO i2 = LBOUND(InData%sigma1c,2), UBOUND(InData%sigma1c,2) + DO i1 = LBOUND(InData%sigma1c,1), UBOUND(InData%sigma1c,1) + ReKiBuf(Re_Xferred) = InData%sigma1c(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%sigma1m) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3920,8 +3915,12 @@ SUBROUTINE UA_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%sigma1m,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%sigma1m)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%sigma1m))-1 ) = PACK(InData%sigma1m,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%sigma1m) + DO i2 = LBOUND(InData%sigma1m,2), UBOUND(InData%sigma1m,2) + DO i1 = LBOUND(InData%sigma1m,1), UBOUND(InData%sigma1m,1) + ReKiBuf(Re_Xferred) = InData%sigma1m(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%sigma3) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3936,8 +3935,12 @@ SUBROUTINE UA_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%sigma3,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%sigma3)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%sigma3))-1 ) = PACK(InData%sigma3,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%sigma3) + DO i2 = LBOUND(InData%sigma3,2), UBOUND(InData%sigma3,2) + DO i1 = LBOUND(InData%sigma3,1), UBOUND(InData%sigma3,1) + ReKiBuf(Re_Xferred) = InData%sigma3(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE UA_PackOtherState @@ -3954,12 +3957,6 @@ SUBROUTINE UA_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -3991,15 +3988,12 @@ SUBROUTINE UA_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FirstPass.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%FirstPass)>0) OutData%FirstPass = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%FirstPass))-1 ), OutData%FirstPass), mask2,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%FirstPass) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%FirstPass,2), UBOUND(OutData%FirstPass,2) + DO i1 = LBOUND(OutData%FirstPass,1), UBOUND(OutData%FirstPass,1) + OutData%FirstPass(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstPass(i1,i2)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! sigma1 not allocated Int_Xferred = Int_Xferred + 1 @@ -4017,15 +4011,12 @@ SUBROUTINE UA_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%sigma1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%sigma1)>0) OutData%sigma1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%sigma1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%sigma1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%sigma1,2), UBOUND(OutData%sigma1,2) + DO i1 = LBOUND(OutData%sigma1,1), UBOUND(OutData%sigma1,1) + OutData%sigma1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! sigma1c not allocated Int_Xferred = Int_Xferred + 1 @@ -4043,15 +4034,12 @@ SUBROUTINE UA_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%sigma1c.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%sigma1c)>0) OutData%sigma1c = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%sigma1c))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%sigma1c) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%sigma1c,2), UBOUND(OutData%sigma1c,2) + DO i1 = LBOUND(OutData%sigma1c,1), UBOUND(OutData%sigma1c,1) + OutData%sigma1c(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! sigma1m not allocated Int_Xferred = Int_Xferred + 1 @@ -4069,15 +4057,12 @@ SUBROUTINE UA_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%sigma1m.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%sigma1m)>0) OutData%sigma1m = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%sigma1m))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%sigma1m) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%sigma1m,2), UBOUND(OutData%sigma1m,2) + DO i1 = LBOUND(OutData%sigma1m,1), UBOUND(OutData%sigma1m,1) + OutData%sigma1m(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! sigma3 not allocated Int_Xferred = Int_Xferred + 1 @@ -4095,15 +4080,12 @@ SUBROUTINE UA_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%sigma3.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%sigma3)>0) OutData%sigma3 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%sigma3))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%sigma3) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%sigma3,2), UBOUND(OutData%sigma3,2) + DO i1 = LBOUND(OutData%sigma3,1), UBOUND(OutData%sigma3,1) + OutData%sigma3(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE UA_UnPackOtherState @@ -4314,12 +4296,12 @@ SUBROUTINE UA_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%FirstWarn_M , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%iBladeNode - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%iBlade - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%FirstWarn_M, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%iBladeNode + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%iBlade + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%TESF) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4333,8 +4315,12 @@ SUBROUTINE UA_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TESF,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TESF)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%TESF)-1 ) = TRANSFER(PACK( InData%TESF ,.TRUE.), IntKiBuf(1), SIZE(InData%TESF)) - Int_Xferred = Int_Xferred + SIZE(InData%TESF) + DO i2 = LBOUND(InData%TESF,2), UBOUND(InData%TESF,2) + DO i1 = LBOUND(InData%TESF,1), UBOUND(InData%TESF,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%TESF(i1,i2), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%LESF) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4349,8 +4335,12 @@ SUBROUTINE UA_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LESF,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LESF)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%LESF)-1 ) = TRANSFER(PACK( InData%LESF ,.TRUE.), IntKiBuf(1), SIZE(InData%LESF)) - Int_Xferred = Int_Xferred + SIZE(InData%LESF) + DO i2 = LBOUND(InData%LESF,2), UBOUND(InData%LESF,2) + DO i1 = LBOUND(InData%LESF,1), UBOUND(InData%LESF,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%LESF(i1,i2), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%VRTX) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4365,8 +4355,12 @@ SUBROUTINE UA_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VRTX,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%VRTX)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%VRTX)-1 ) = TRANSFER(PACK( InData%VRTX ,.TRUE.), IntKiBuf(1), SIZE(InData%VRTX)) - Int_Xferred = Int_Xferred + SIZE(InData%VRTX) + DO i2 = LBOUND(InData%VRTX,2), UBOUND(InData%VRTX,2) + DO i1 = LBOUND(InData%VRTX,1), UBOUND(InData%VRTX,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%VRTX(i1,i2), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%T_Sh) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4381,8 +4375,12 @@ SUBROUTINE UA_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%T_Sh,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%T_Sh)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%T_Sh))-1 ) = PACK(InData%T_Sh,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%T_Sh) + DO i2 = LBOUND(InData%T_Sh,2), UBOUND(InData%T_Sh,2) + DO i1 = LBOUND(InData%T_Sh,1), UBOUND(InData%T_Sh,1) + ReKiBuf(Re_Xferred) = InData%T_Sh(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%BEDSEP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4397,8 +4395,12 @@ SUBROUTINE UA_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BEDSEP,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BEDSEP)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%BEDSEP)-1 ) = TRANSFER(PACK( InData%BEDSEP ,.TRUE.), IntKiBuf(1), SIZE(InData%BEDSEP)) - Int_Xferred = Int_Xferred + SIZE(InData%BEDSEP) + DO i2 = LBOUND(InData%BEDSEP,2), UBOUND(InData%BEDSEP,2) + DO i1 = LBOUND(InData%BEDSEP,1), UBOUND(InData%BEDSEP,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%BEDSEP(i1,i2), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF END SUBROUTINE UA_PackMisc @@ -4415,12 +4417,6 @@ SUBROUTINE UA_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -4436,12 +4432,12 @@ SUBROUTINE UA_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%FirstWarn_M = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%iBladeNode = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%iBlade = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%FirstWarn_M = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstWarn_M) + Int_Xferred = Int_Xferred + 1 + OutData%iBladeNode = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%iBlade = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TESF not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -4458,15 +4454,12 @@ SUBROUTINE UA_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TESF.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%TESF)>0) OutData%TESF = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%TESF))-1 ), OutData%TESF), mask2,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%TESF) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%TESF,2), UBOUND(OutData%TESF,2) + DO i1 = LBOUND(OutData%TESF,1), UBOUND(OutData%TESF,1) + OutData%TESF(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%TESF(i1,i2)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LESF not allocated Int_Xferred = Int_Xferred + 1 @@ -4484,15 +4477,12 @@ SUBROUTINE UA_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LESF.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%LESF)>0) OutData%LESF = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%LESF))-1 ), OutData%LESF), mask2,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%LESF) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%LESF,2), UBOUND(OutData%LESF,2) + DO i1 = LBOUND(OutData%LESF,1), UBOUND(OutData%LESF,1) + OutData%LESF(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%LESF(i1,i2)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VRTX not allocated Int_Xferred = Int_Xferred + 1 @@ -4510,15 +4500,12 @@ SUBROUTINE UA_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VRTX.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%VRTX)>0) OutData%VRTX = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%VRTX))-1 ), OutData%VRTX), mask2,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%VRTX) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%VRTX,2), UBOUND(OutData%VRTX,2) + DO i1 = LBOUND(OutData%VRTX,1), UBOUND(OutData%VRTX,1) + OutData%VRTX(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%VRTX(i1,i2)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! T_Sh not allocated Int_Xferred = Int_Xferred + 1 @@ -4536,15 +4523,12 @@ SUBROUTINE UA_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%T_Sh.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%T_Sh)>0) OutData%T_Sh = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%T_Sh))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%T_Sh) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%T_Sh,2), UBOUND(OutData%T_Sh,2) + DO i1 = LBOUND(OutData%T_Sh,1), UBOUND(OutData%T_Sh,1) + OutData%T_Sh(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BEDSEP not allocated Int_Xferred = Int_Xferred + 1 @@ -4562,15 +4546,12 @@ SUBROUTINE UA_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BEDSEP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%BEDSEP)>0) OutData%BEDSEP = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%BEDSEP))-1 ), OutData%BEDSEP), mask2,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%BEDSEP) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%BEDSEP,2), UBOUND(OutData%BEDSEP,2) + DO i1 = LBOUND(OutData%BEDSEP,1), UBOUND(OutData%BEDSEP,1) + OutData%BEDSEP(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%BEDSEP(i1,i2)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF END SUBROUTINE UA_UnPackMisc @@ -4711,8 +4692,8 @@ SUBROUTINE UA_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%dt - Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%dt + Db_Xferred = Db_Xferred + 1 IF ( .NOT. ALLOCATED(InData%c) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4726,37 +4707,41 @@ SUBROUTINE UA_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%c,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%c)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%c))-1 ) = PACK(InData%c,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%c) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%numBlades - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%nNodesPerBlade - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UAMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Flookup , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%a_s - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%OutSwtch - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%OutSFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutSFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%Delim) - IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UnOutFile - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(InData%c,2), UBOUND(InData%c,2) + DO i1 = LBOUND(InData%c,1), UBOUND(InData%c,1) + ReKiBuf(Re_Xferred) = InData%c(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IntKiBuf(Int_Xferred) = InData%numBlades + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nNodesPerBlade + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%UAMod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%Flookup, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%a_s + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%OutSwtch + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%OutFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%OutSFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutSFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%Delim) + IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%UnOutFile + Int_Xferred = Int_Xferred + 1 END SUBROUTINE UA_PackParam SUBROUTINE UA_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -4772,12 +4757,6 @@ SUBROUTINE UA_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -4793,8 +4772,8 @@ SUBROUTINE UA_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%dt = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%dt = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! c not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -4811,44 +4790,41 @@ SUBROUTINE UA_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%c.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%c)>0) OutData%c = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%c))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%c) - DEALLOCATE(mask2) - END IF - OutData%numBlades = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%nNodesPerBlade = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%UAMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%Flookup = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%a_s = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%OutSwtch = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutFmt) - OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%OutSFmt) - OutData%OutSFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Delim) - OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%UnOutFile = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(OutData%c,2), UBOUND(OutData%c,2) + DO i1 = LBOUND(OutData%c,1), UBOUND(OutData%c,1) + OutData%c(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%numBlades = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nNodesPerBlade = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%UAMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%Flookup = TRANSFER(IntKiBuf(Int_Xferred), OutData%Flookup) + Int_Xferred = Int_Xferred + 1 + OutData%a_s = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%OutSwtch = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%OutFmt) + OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%OutSFmt) + OutData%OutSFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%Delim) + OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%UnOutFile = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE UA_UnPackParam SUBROUTINE UA_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -4948,14 +4924,14 @@ SUBROUTINE UA_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%U - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%alpha - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Re - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%UserProp - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%U + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%alpha + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Re + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%UserProp + Re_Xferred = Re_Xferred + 1 END SUBROUTINE UA_PackInput SUBROUTINE UA_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -4971,12 +4947,6 @@ SUBROUTINE UA_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'UA_UnPackInput' @@ -4990,14 +4960,14 @@ SUBROUTINE UA_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%U = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%alpha = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Re = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%UserProp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%U = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%alpha = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Re = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%UserProp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE UA_UnPackInput SUBROUTINE UA_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -5120,16 +5090,16 @@ SUBROUTINE UA_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cc - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cm - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cl - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cd - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cc + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cm + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cl + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cd + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WriteOutput) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -5140,8 +5110,10 @@ SUBROUTINE UA_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WriteOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WriteOutput))-1 ) = PACK(InData%WriteOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WriteOutput) + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE UA_PackOutput @@ -5158,12 +5130,6 @@ SUBROUTINE UA_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -5178,16 +5144,16 @@ SUBROUTINE UA_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%Cn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cm = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cl = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cd = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%Cn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cm = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cl = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cd = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutput not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5201,15 +5167,10 @@ SUBROUTINE UA_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WriteOutput)>0) OutData%WriteOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WriteOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WriteOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE UA_UnPackOutput @@ -5288,8 +5249,8 @@ SUBROUTINE UA_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'UA_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -5304,14 +5265,16 @@ SUBROUTINE UA_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - b0 = -(u1%U - u2%U)/t(2) - u_out%U = u1%U + b0 * t_out - b0 = -(u1%alpha - u2%alpha)/t(2) - u_out%alpha = u1%alpha + b0 * t_out - b0 = -(u1%Re - u2%Re)/t(2) - u_out%Re = u1%Re + b0 * t_out - b0 = -(u1%UserProp - u2%UserProp)/t(2) - u_out%UserProp = u1%UserProp + b0 * t_out + + ScaleFactor = t_out / t(2) + b = -(u1%U - u2%U) + u_out%U = u1%U + b * ScaleFactor + b = -(u1%alpha - u2%alpha) + u_out%alpha = u1%alpha + b * ScaleFactor + b = -(u1%Re - u2%Re) + u_out%Re = u1%Re + b * ScaleFactor + b = -(u1%UserProp - u2%UserProp) + u_out%UserProp = u1%UserProp + b * ScaleFactor END SUBROUTINE UA_Input_ExtrapInterp1 @@ -5341,8 +5304,9 @@ SUBROUTINE UA_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'UA_Input_ExtrapInterp2' @@ -5364,18 +5328,20 @@ SUBROUTINE UA_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - b0 = (t(3)**2*(u1%U - u2%U) + t(2)**2*(-u1%U + u3%U))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%U + t(3)*u2%U - t(2)*u3%U ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%U = u1%U + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%alpha - u2%alpha) + t(2)**2*(-u1%alpha + u3%alpha))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%alpha + t(3)*u2%alpha - t(2)*u3%alpha ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%alpha = u1%alpha + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%Re - u2%Re) + t(2)**2*(-u1%Re + u3%Re))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%Re + t(3)*u2%Re - t(2)*u3%Re ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Re = u1%Re + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%UserProp - u2%UserProp) + t(2)**2*(-u1%UserProp + u3%UserProp))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%UserProp + t(3)*u2%UserProp - t(2)*u3%UserProp ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%UserProp = u1%UserProp + b0 * t_out + c0 * t_out**2 + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) + b = (t(3)**2*(u1%U - u2%U) + t(2)**2*(-u1%U + u3%U))* scaleFactor + c = ( (t(2)-t(3))*u1%U + t(3)*u2%U - t(2)*u3%U ) * scaleFactor + u_out%U = u1%U + b + c * t_out + b = (t(3)**2*(u1%alpha - u2%alpha) + t(2)**2*(-u1%alpha + u3%alpha))* scaleFactor + c = ( (t(2)-t(3))*u1%alpha + t(3)*u2%alpha - t(2)*u3%alpha ) * scaleFactor + u_out%alpha = u1%alpha + b + c * t_out + b = (t(3)**2*(u1%Re - u2%Re) + t(2)**2*(-u1%Re + u3%Re))* scaleFactor + c = ( (t(2)-t(3))*u1%Re + t(3)*u2%Re - t(2)*u3%Re ) * scaleFactor + u_out%Re = u1%Re + b + c * t_out + b = (t(3)**2*(u1%UserProp - u2%UserProp) + t(2)**2*(-u1%UserProp + u3%UserProp))* scaleFactor + c = ( (t(2)-t(3))*u1%UserProp + t(3)*u2%UserProp - t(2)*u3%UserProp ) * scaleFactor + u_out%UserProp = u1%UserProp + b + c * t_out END SUBROUTINE UA_Input_ExtrapInterp2 @@ -5453,12 +5419,12 @@ SUBROUTINE UA_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'UA_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -5471,23 +5437,23 @@ SUBROUTINE UA_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - b0 = -(y1%Cn - y2%Cn)/t(2) - y_out%Cn = y1%Cn + b0 * t_out - b0 = -(y1%Cc - y2%Cc)/t(2) - y_out%Cc = y1%Cc + b0 * t_out - b0 = -(y1%Cm - y2%Cm)/t(2) - y_out%Cm = y1%Cm + b0 * t_out - b0 = -(y1%Cl - y2%Cl)/t(2) - y_out%Cl = y1%Cl + b0 * t_out - b0 = -(y1%Cd - y2%Cd)/t(2) - y_out%Cd = y1%Cd + b0 * t_out + + ScaleFactor = t_out / t(2) + b = -(y1%Cn - y2%Cn) + y_out%Cn = y1%Cn + b * ScaleFactor + b = -(y1%Cc - y2%Cc) + y_out%Cc = y1%Cc + b * ScaleFactor + b = -(y1%Cm - y2%Cm) + y_out%Cm = y1%Cm + b * ScaleFactor + b = -(y1%Cl - y2%Cl) + y_out%Cl = y1%Cl + b * ScaleFactor + b = -(y1%Cd - y2%Cd) + y_out%Cd = y1%Cd + b * ScaleFactor IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = -(y1%WriteOutput - y2%WriteOutput)/t(2) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO END IF ! check if allocated END SUBROUTINE UA_Output_ExtrapInterp1 @@ -5518,13 +5484,14 @@ SUBROUTINE UA_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'UA_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -5543,29 +5510,29 @@ SUBROUTINE UA_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - b0 = (t(3)**2*(y1%Cn - y2%Cn) + t(2)**2*(-y1%Cn + y3%Cn))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%Cn + t(3)*y2%Cn - t(2)*y3%Cn ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Cn = y1%Cn + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%Cc - y2%Cc) + t(2)**2*(-y1%Cc + y3%Cc))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%Cc + t(3)*y2%Cc - t(2)*y3%Cc ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Cc = y1%Cc + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%Cm - y2%Cm) + t(2)**2*(-y1%Cm + y3%Cm))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%Cm + t(3)*y2%Cm - t(2)*y3%Cm ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Cm = y1%Cm + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%Cl - y2%Cl) + t(2)**2*(-y1%Cl + y3%Cl))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%Cl + t(3)*y2%Cl - t(2)*y3%Cl ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Cl = y1%Cl + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%Cd - y2%Cd) + t(2)**2*(-y1%Cd + y3%Cd))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%Cd + t(3)*y2%Cd - t(2)*y3%Cd ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Cd = y1%Cd + b0 * t_out + c0 * t_out**2 + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) + b = (t(3)**2*(y1%Cn - y2%Cn) + t(2)**2*(-y1%Cn + y3%Cn))* scaleFactor + c = ( (t(2)-t(3))*y1%Cn + t(3)*y2%Cn - t(2)*y3%Cn ) * scaleFactor + y_out%Cn = y1%Cn + b + c * t_out + b = (t(3)**2*(y1%Cc - y2%Cc) + t(2)**2*(-y1%Cc + y3%Cc))* scaleFactor + c = ( (t(2)-t(3))*y1%Cc + t(3)*y2%Cc - t(2)*y3%Cc ) * scaleFactor + y_out%Cc = y1%Cc + b + c * t_out + b = (t(3)**2*(y1%Cm - y2%Cm) + t(2)**2*(-y1%Cm + y3%Cm))* scaleFactor + c = ( (t(2)-t(3))*y1%Cm + t(3)*y2%Cm - t(2)*y3%Cm ) * scaleFactor + y_out%Cm = y1%Cm + b + c * t_out + b = (t(3)**2*(y1%Cl - y2%Cl) + t(2)**2*(-y1%Cl + y3%Cl))* scaleFactor + c = ( (t(2)-t(3))*y1%Cl + t(3)*y2%Cl - t(2)*y3%Cl ) * scaleFactor + y_out%Cl = y1%Cl + b + c * t_out + b = (t(3)**2*(y1%Cd - y2%Cd) + t(2)**2*(-y1%Cd + y3%Cd))* scaleFactor + c = ( (t(2)-t(3))*y1%Cd + t(3)*y2%Cd - t(2)*y3%Cd ) * scaleFactor + y_out%Cd = y1%Cd + b + c * t_out IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = (t(3)**2*(y1%WriteOutput - y2%WriteOutput) + t(2)**2*(-y1%WriteOutput + y3%WriteOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WriteOutput + t(3)*y2%WriteOutput - t(2)*y3%WriteOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO END IF ! check if allocated END SUBROUTINE UA_Output_ExtrapInterp2 diff --git a/modules/aerodyn14/src/AeroDyn14_Types.f90 b/modules/aerodyn14/src/AeroDyn14_Types.f90 index 315d478986..ad4321d6bf 100644 --- a/modules/aerodyn14/src/AeroDyn14_Types.f90 +++ b/modules/aerodyn14/src/AeroDyn14_Types.f90 @@ -577,14 +577,24 @@ SUBROUTINE AD14_PackMarker( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Position))-1 ) = PACK(InData%Position,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Position) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Orientation))-1 ) = PACK(InData%Orientation,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Orientation) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TranslationVel))-1 ) = PACK(InData%TranslationVel,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TranslationVel) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RotationVel))-1 ) = PACK(InData%RotationVel,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RotationVel) + DO i1 = LBOUND(InData%Position,1), UBOUND(InData%Position,1) + ReKiBuf(Re_Xferred) = InData%Position(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i2 = LBOUND(InData%Orientation,2), UBOUND(InData%Orientation,2) + DO i1 = LBOUND(InData%Orientation,1), UBOUND(InData%Orientation,1) + ReKiBuf(Re_Xferred) = InData%Orientation(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i1 = LBOUND(InData%TranslationVel,1), UBOUND(InData%TranslationVel,1) + ReKiBuf(Re_Xferred) = InData%TranslationVel(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%RotationVel,1), UBOUND(InData%RotationVel,1) + ReKiBuf(Re_Xferred) = InData%RotationVel(i1) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE AD14_PackMarker SUBROUTINE AD14_UnPackMarker( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -600,12 +610,6 @@ SUBROUTINE AD14_UnPackMarker( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (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 @@ -624,50 +628,32 @@ SUBROUTINE AD14_UnPackMarker( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM Int_Xferred = 1 i1_l = LBOUND(OutData%Position,1) i1_u = UBOUND(OutData%Position,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%Position = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Position))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Position) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Position,1), UBOUND(OutData%Position,1) + OutData%Position(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%Orientation,1) i1_u = UBOUND(OutData%Orientation,1) i2_l = LBOUND(OutData%Orientation,2) i2_u = UBOUND(OutData%Orientation,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%Orientation = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Orientation))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Orientation) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Orientation,2), UBOUND(OutData%Orientation,2) + DO i1 = LBOUND(OutData%Orientation,1), UBOUND(OutData%Orientation,1) + OutData%Orientation(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%TranslationVel,1) i1_u = UBOUND(OutData%TranslationVel,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%TranslationVel = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TranslationVel))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TranslationVel) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TranslationVel,1), UBOUND(OutData%TranslationVel,1) + OutData%TranslationVel(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%RotationVel,1) i1_u = UBOUND(OutData%RotationVel,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%RotationVel = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RotationVel))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RotationVel) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%RotationVel,1), UBOUND(OutData%RotationVel,1) + OutData%RotationVel(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE AD14_UnPackMarker SUBROUTINE AD14_CopyAeroConfig( SrcAeroConfigData, DstAeroConfigData, CtrlCode, ErrStat, ErrMsg ) @@ -1192,8 +1178,8 @@ SUBROUTINE AD14_PackAeroConfig( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%BladeLength - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%BladeLength + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AD14_PackAeroConfig SUBROUTINE AD14_UnPackAeroConfig( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1209,12 +1195,6 @@ SUBROUTINE AD14_UnPackAeroConfig( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1565,8 +1545,8 @@ SUBROUTINE AD14_UnPackAeroConfig( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%BladeLength = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%BladeLength = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AD14_UnPackAeroConfig SUBROUTINE AD14_CopyAirFoil( SrcAirFoilData, DstAirFoilData, CtrlCode, ErrStat, ErrMsg ) @@ -1772,8 +1752,12 @@ SUBROUTINE AD14_PackAirFoil( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AL,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AL)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AL))-1 ) = PACK(InData%AL,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AL) + DO i2 = LBOUND(InData%AL,2), UBOUND(InData%AL,2) + DO i1 = LBOUND(InData%AL,1), UBOUND(InData%AL,1) + ReKiBuf(Re_Xferred) = InData%AL(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%CD) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1791,8 +1775,14 @@ SUBROUTINE AD14_PackAirFoil( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CD,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CD)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CD))-1 ) = PACK(InData%CD,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CD) + DO i3 = LBOUND(InData%CD,3), UBOUND(InData%CD,3) + DO i2 = LBOUND(InData%CD,2), UBOUND(InData%CD,2) + DO i1 = LBOUND(InData%CD,1), UBOUND(InData%CD,1) + ReKiBuf(Re_Xferred) = InData%CD(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%CL) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1810,8 +1800,14 @@ SUBROUTINE AD14_PackAirFoil( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CL,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CL)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CL))-1 ) = PACK(InData%CL,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CL) + DO i3 = LBOUND(InData%CL,3), UBOUND(InData%CL,3) + DO i2 = LBOUND(InData%CL,2), UBOUND(InData%CL,2) + DO i1 = LBOUND(InData%CL,1), UBOUND(InData%CL,1) + ReKiBuf(Re_Xferred) = InData%CL(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%CM) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1829,13 +1825,19 @@ SUBROUTINE AD14_PackAirFoil( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CM,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CM)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CM))-1 ) = PACK(InData%CM,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CM) + DO i3 = LBOUND(InData%CM,3), UBOUND(InData%CM,3) + DO i2 = LBOUND(InData%CM,2), UBOUND(InData%CM,2) + DO i1 = LBOUND(InData%CM,1), UBOUND(InData%CM,1) + ReKiBuf(Re_Xferred) = InData%CM(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PMC - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MulTabLoc - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PMC + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MulTabLoc + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AD14_PackAirFoil SUBROUTINE AD14_UnPackAirFoil( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1851,12 +1853,6 @@ SUBROUTINE AD14_UnPackAirFoil( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (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 @@ -1889,15 +1885,12 @@ SUBROUTINE AD14_UnPackAirFoil( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AL.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%AL)>0) OutData%AL = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AL))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AL) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AL,2), UBOUND(OutData%AL,2) + DO i1 = LBOUND(OutData%AL,1), UBOUND(OutData%AL,1) + OutData%AL(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CD not allocated Int_Xferred = Int_Xferred + 1 @@ -1918,15 +1911,14 @@ SUBROUTINE AD14_UnPackAirFoil( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CD.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%CD)>0) OutData%CD = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CD))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CD) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%CD,3), UBOUND(OutData%CD,3) + DO i2 = LBOUND(OutData%CD,2), UBOUND(OutData%CD,2) + DO i1 = LBOUND(OutData%CD,1), UBOUND(OutData%CD,1) + OutData%CD(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CL not allocated Int_Xferred = Int_Xferred + 1 @@ -1947,15 +1939,14 @@ SUBROUTINE AD14_UnPackAirFoil( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CL.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%CL)>0) OutData%CL = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CL))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CL) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%CL,3), UBOUND(OutData%CL,3) + DO i2 = LBOUND(OutData%CL,2), UBOUND(OutData%CL,2) + DO i1 = LBOUND(OutData%CL,1), UBOUND(OutData%CL,1) + OutData%CL(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CM not allocated Int_Xferred = Int_Xferred + 1 @@ -1976,20 +1967,19 @@ SUBROUTINE AD14_UnPackAirFoil( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CM.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%CM)>0) OutData%CM = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CM))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CM) - DEALLOCATE(mask3) - END IF - OutData%PMC = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MulTabLoc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i3 = LBOUND(OutData%CM,3), UBOUND(OutData%CM,3) + DO i2 = LBOUND(OutData%CM,2), UBOUND(OutData%CM,2) + DO i1 = LBOUND(OutData%CM,1), UBOUND(OutData%CM,1) + OutData%CM(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + OutData%PMC = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MulTabLoc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AD14_UnPackAirFoil SUBROUTINE AD14_CopyAirFoilParms( SrcAirFoilParmsData, DstAirFoilParmsData, CtrlCode, ErrStat, ErrMsg ) @@ -2191,8 +2181,8 @@ SUBROUTINE AD14_PackAirFoilParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MaxTable - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MaxTable + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%NTables) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2203,8 +2193,10 @@ SUBROUTINE AD14_PackAirFoilParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NTables,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%NTables)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%NTables))-1 ) = PACK(InData%NTables,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%NTables) + DO i1 = LBOUND(InData%NTables,1), UBOUND(InData%NTables,1) + IntKiBuf(Int_Xferred) = InData%NTables(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%NLift) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2216,13 +2208,15 @@ SUBROUTINE AD14_PackAirFoilParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NLift,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%NLift)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%NLift))-1 ) = PACK(InData%NLift,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%NLift) + DO i1 = LBOUND(InData%NLift,1), UBOUND(InData%NLift,1) + IntKiBuf(Int_Xferred) = InData%NLift(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumCL - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumFoil - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumCL + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumFoil + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%NFoil) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2233,8 +2227,10 @@ SUBROUTINE AD14_PackAirFoilParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NFoil,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%NFoil)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%NFoil))-1 ) = PACK(InData%NFoil,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%NFoil) + DO i1 = LBOUND(InData%NFoil,1), UBOUND(InData%NFoil,1) + IntKiBuf(Int_Xferred) = InData%NFoil(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%MulTabMet) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2249,8 +2245,12 @@ SUBROUTINE AD14_PackAirFoilParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MulTabMet,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%MulTabMet)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MulTabMet))-1 ) = PACK(InData%MulTabMet,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MulTabMet) + DO i2 = LBOUND(InData%MulTabMet,2), UBOUND(InData%MulTabMet,2) + DO i1 = LBOUND(InData%MulTabMet,1), UBOUND(InData%MulTabMet,1) + ReKiBuf(Re_Xferred) = InData%MulTabMet(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%FoilNm) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2262,12 +2262,12 @@ SUBROUTINE AD14_PackAirFoilParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FoilNm,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%FoilNm,1), UBOUND(InData%FoilNm,1) + DO i1 = LBOUND(InData%FoilNm,1), UBOUND(InData%FoilNm,1) DO I = 1, LEN(InData%FoilNm) IntKiBuf(Int_Xferred) = ICHAR(InData%FoilNm(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF END SUBROUTINE AD14_PackAirFoilParms @@ -2284,12 +2284,6 @@ SUBROUTINE AD14_UnPackAirFoilParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -2305,8 +2299,8 @@ SUBROUTINE AD14_UnPackAirFoilParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%MaxTable = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%MaxTable = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NTables not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -2320,15 +2314,10 @@ SUBROUTINE AD14_UnPackAirFoilParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NTables.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%NTables)>0) OutData%NTables = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%NTables))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%NTables) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%NTables,1), UBOUND(OutData%NTables,1) + OutData%NTables(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NLift not allocated Int_Xferred = Int_Xferred + 1 @@ -2343,20 +2332,15 @@ SUBROUTINE AD14_UnPackAirFoilParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NLift.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%NLift)>0) OutData%NLift = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%NLift))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%NLift) - DEALLOCATE(mask1) - END IF - OutData%NumCL = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumFoil = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%NLift,1), UBOUND(OutData%NLift,1) + OutData%NLift(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + OutData%NumCL = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumFoil = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NFoil not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -2370,15 +2354,10 @@ SUBROUTINE AD14_UnPackAirFoilParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NFoil.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%NFoil)>0) OutData%NFoil = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%NFoil))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%NFoil) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%NFoil,1), UBOUND(OutData%NFoil,1) + OutData%NFoil(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MulTabMet not allocated Int_Xferred = Int_Xferred + 1 @@ -2396,15 +2375,12 @@ SUBROUTINE AD14_UnPackAirFoilParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MulTabMet.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%MulTabMet)>0) OutData%MulTabMet = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MulTabMet))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%MulTabMet) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%MulTabMet,2), UBOUND(OutData%MulTabMet,2) + DO i1 = LBOUND(OutData%MulTabMet,1), UBOUND(OutData%MulTabMet,1) + OutData%MulTabMet(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FoilNm not allocated Int_Xferred = Int_Xferred + 1 @@ -2419,19 +2395,12 @@ SUBROUTINE AD14_UnPackAirFoilParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FoilNm.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%FoilNm,1), UBOUND(OutData%FoilNm,1) + DO i1 = LBOUND(OutData%FoilNm,1), UBOUND(OutData%FoilNm,1) DO I = 1, LEN(OutData%FoilNm) OutData%FoilNm(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF END SUBROUTINE AD14_UnPackAirFoilParms @@ -3714,8 +3683,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ADOT,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ADOT)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%ADOT))-1 ) = PACK(InData%ADOT,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%ADOT) + DO i2 = LBOUND(InData%ADOT,2), UBOUND(InData%ADOT,2) + DO i1 = LBOUND(InData%ADOT,1), UBOUND(InData%ADOT,1) + ReKiBuf(Re_Xferred) = InData%ADOT(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%ADOT1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3730,8 +3703,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ADOT1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ADOT1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%ADOT1))-1 ) = PACK(InData%ADOT1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%ADOT1) + DO i2 = LBOUND(InData%ADOT1,2), UBOUND(InData%ADOT1,2) + DO i1 = LBOUND(InData%ADOT1,1), UBOUND(InData%ADOT1,1) + ReKiBuf(Re_Xferred) = InData%ADOT1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%AFE) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3746,8 +3723,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFE,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AFE)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AFE))-1 ) = PACK(InData%AFE,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AFE) + DO i2 = LBOUND(InData%AFE,2), UBOUND(InData%AFE,2) + DO i1 = LBOUND(InData%AFE,1), UBOUND(InData%AFE,1) + ReKiBuf(Re_Xferred) = InData%AFE(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%AFE1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3762,11 +3743,15 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AFE1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AFE1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AFE1))-1 ) = PACK(InData%AFE1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AFE1) + DO i2 = LBOUND(InData%AFE1,2), UBOUND(InData%AFE1,2) + DO i1 = LBOUND(InData%AFE1,1), UBOUND(InData%AFE1,1) + ReKiBuf(Re_Xferred) = InData%AFE1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AN - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AN + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%ANE) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -3780,8 +3765,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ANE,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ANE)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%ANE))-1 ) = PACK(InData%ANE,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%ANE) + DO i2 = LBOUND(InData%ANE,2), UBOUND(InData%ANE,2) + DO i1 = LBOUND(InData%ANE,1), UBOUND(InData%ANE,1) + ReKiBuf(Re_Xferred) = InData%ANE(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%ANE1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3796,8 +3785,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ANE1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ANE1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%ANE1))-1 ) = PACK(InData%ANE1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%ANE1) + DO i2 = LBOUND(InData%ANE1,2), UBOUND(InData%ANE1,2) + DO i1 = LBOUND(InData%ANE1,1), UBOUND(InData%ANE1,1) + ReKiBuf(Re_Xferred) = InData%ANE1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%AOD) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3812,8 +3805,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AOD,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AOD)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AOD))-1 ) = PACK(InData%AOD,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AOD) + DO i2 = LBOUND(InData%AOD,2), UBOUND(InData%AOD,2) + DO i1 = LBOUND(InData%AOD,1), UBOUND(InData%AOD,1) + ReKiBuf(Re_Xferred) = InData%AOD(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%AOL) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3828,8 +3825,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AOL,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AOL)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AOL))-1 ) = PACK(InData%AOL,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AOL) + DO i2 = LBOUND(InData%AOL,2), UBOUND(InData%AOL,2) + DO i1 = LBOUND(InData%AOL,1), UBOUND(InData%AOL,1) + ReKiBuf(Re_Xferred) = InData%AOL(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%BEDSEP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3844,8 +3845,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BEDSEP,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BEDSEP)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%BEDSEP)-1 ) = TRANSFER(PACK( InData%BEDSEP ,.TRUE.), IntKiBuf(1), SIZE(InData%BEDSEP)) - Int_Xferred = Int_Xferred + SIZE(InData%BEDSEP) + DO i2 = LBOUND(InData%BEDSEP,2), UBOUND(InData%BEDSEP,2) + DO i1 = LBOUND(InData%BEDSEP,1), UBOUND(InData%BEDSEP,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%BEDSEP(i1,i2), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%OLDSEP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3860,11 +3865,15 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDSEP,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%OLDSEP)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%OLDSEP)-1 ) = TRANSFER(PACK( InData%OLDSEP ,.TRUE.), IntKiBuf(1), SIZE(InData%OLDSEP)) - Int_Xferred = Int_Xferred + SIZE(InData%OLDSEP) + DO i2 = LBOUND(InData%OLDSEP,2), UBOUND(InData%OLDSEP,2) + DO i1 = LBOUND(InData%OLDSEP,1), UBOUND(InData%OLDSEP,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%OLDSEP(i1,i2), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CC - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CC + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%CDO) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -3878,15 +3887,19 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CDO,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CDO)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CDO))-1 ) = PACK(InData%CDO,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CDO) + DO i2 = LBOUND(InData%CDO,2), UBOUND(InData%CDO,2) + DO i1 = LBOUND(InData%CDO,1), UBOUND(InData%CDO,1) + ReKiBuf(Re_Xferred) = InData%CDO(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CMI - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CMQ - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CN - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CMI + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CMQ + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CN + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%CNA) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -3900,13 +3913,17 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNA,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CNA)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CNA))-1 ) = PACK(InData%CNA,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CNA) + DO i2 = LBOUND(InData%CNA,2), UBOUND(InData%CNA,2) + DO i1 = LBOUND(InData%CNA,1), UBOUND(InData%CNA,1) + ReKiBuf(Re_Xferred) = InData%CNA(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CNCP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CNIQ - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CNCP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CNIQ + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%CNP) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -3920,8 +3937,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNP,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CNP)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CNP))-1 ) = PACK(InData%CNP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CNP) + DO i2 = LBOUND(InData%CNP,2), UBOUND(InData%CNP,2) + DO i1 = LBOUND(InData%CNP,1), UBOUND(InData%CNP,1) + ReKiBuf(Re_Xferred) = InData%CNP(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%CNP1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3936,8 +3957,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNP1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CNP1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CNP1))-1 ) = PACK(InData%CNP1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CNP1) + DO i2 = LBOUND(InData%CNP1,2), UBOUND(InData%CNP1,2) + DO i1 = LBOUND(InData%CNP1,1), UBOUND(InData%CNP1,1) + ReKiBuf(Re_Xferred) = InData%CNP1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%CNPD) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3952,8 +3977,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNPD,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CNPD)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CNPD))-1 ) = PACK(InData%CNPD,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CNPD) + DO i2 = LBOUND(InData%CNPD,2), UBOUND(InData%CNPD,2) + DO i1 = LBOUND(InData%CNPD,1), UBOUND(InData%CNPD,1) + ReKiBuf(Re_Xferred) = InData%CNPD(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%CNPD1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3968,8 +3997,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNPD1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CNPD1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CNPD1))-1 ) = PACK(InData%CNPD1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CNPD1) + DO i2 = LBOUND(InData%CNPD1,2), UBOUND(InData%CNPD1,2) + DO i1 = LBOUND(InData%CNPD1,1), UBOUND(InData%CNPD1,1) + ReKiBuf(Re_Xferred) = InData%CNPD1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%CNPOT) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3984,8 +4017,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNPOT,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CNPOT)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CNPOT))-1 ) = PACK(InData%CNPOT,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CNPOT) + DO i2 = LBOUND(InData%CNPOT,2), UBOUND(InData%CNPOT,2) + DO i1 = LBOUND(InData%CNPOT,1), UBOUND(InData%CNPOT,1) + ReKiBuf(Re_Xferred) = InData%CNPOT(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%CNPOT1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4000,8 +4037,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNPOT1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CNPOT1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CNPOT1))-1 ) = PACK(InData%CNPOT1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CNPOT1) + DO i2 = LBOUND(InData%CNPOT1,2), UBOUND(InData%CNPOT1,2) + DO i1 = LBOUND(InData%CNPOT1,1), UBOUND(InData%CNPOT1,1) + ReKiBuf(Re_Xferred) = InData%CNPOT1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%CNS) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4016,8 +4057,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNS,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CNS)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CNS))-1 ) = PACK(InData%CNS,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CNS) + DO i2 = LBOUND(InData%CNS,2), UBOUND(InData%CNS,2) + DO i1 = LBOUND(InData%CNS,1), UBOUND(InData%CNS,1) + ReKiBuf(Re_Xferred) = InData%CNS(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%CNSL) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4032,8 +4077,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNSL,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CNSL)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CNSL))-1 ) = PACK(InData%CNSL,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CNSL) + DO i2 = LBOUND(InData%CNSL,2), UBOUND(InData%CNSL,2) + DO i1 = LBOUND(InData%CNSL,1), UBOUND(InData%CNSL,1) + ReKiBuf(Re_Xferred) = InData%CNSL(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%CNV) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4048,8 +4097,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNV,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CNV)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CNV))-1 ) = PACK(InData%CNV,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CNV) + DO i2 = LBOUND(InData%CNV,2), UBOUND(InData%CNV,2) + DO i1 = LBOUND(InData%CNV,1), UBOUND(InData%CNV,1) + ReKiBuf(Re_Xferred) = InData%CNV(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%CVN) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4064,8 +4117,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CVN,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CVN)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CVN))-1 ) = PACK(InData%CVN,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CVN) + DO i2 = LBOUND(InData%CVN,2), UBOUND(InData%CVN,2) + DO i1 = LBOUND(InData%CVN,1), UBOUND(InData%CVN,1) + ReKiBuf(Re_Xferred) = InData%CVN(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%CVN1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4080,8 +4137,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CVN1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CVN1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CVN1))-1 ) = PACK(InData%CVN1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CVN1) + DO i2 = LBOUND(InData%CVN1,2), UBOUND(InData%CVN1,2) + DO i1 = LBOUND(InData%CVN1,1), UBOUND(InData%CVN1,1) + ReKiBuf(Re_Xferred) = InData%CVN1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%DF) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4096,8 +4157,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DF,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DF)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%DF))-1 ) = PACK(InData%DF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%DF) + DO i2 = LBOUND(InData%DF,2), UBOUND(InData%DF,2) + DO i1 = LBOUND(InData%DF,1), UBOUND(InData%DF,1) + ReKiBuf(Re_Xferred) = InData%DF(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%DFAFE) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4112,8 +4177,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DFAFE,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DFAFE)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%DFAFE))-1 ) = PACK(InData%DFAFE,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%DFAFE) + DO i2 = LBOUND(InData%DFAFE,2), UBOUND(InData%DFAFE,2) + DO i1 = LBOUND(InData%DFAFE,1), UBOUND(InData%DFAFE,1) + ReKiBuf(Re_Xferred) = InData%DFAFE(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%DFAFE1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4128,8 +4197,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DFAFE1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DFAFE1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%DFAFE1))-1 ) = PACK(InData%DFAFE1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%DFAFE1) + DO i2 = LBOUND(InData%DFAFE1,2), UBOUND(InData%DFAFE1,2) + DO i1 = LBOUND(InData%DFAFE1,1), UBOUND(InData%DFAFE1,1) + ReKiBuf(Re_Xferred) = InData%DFAFE1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%DFC) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4144,8 +4217,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DFC,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DFC)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%DFC))-1 ) = PACK(InData%DFC,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%DFC) + DO i2 = LBOUND(InData%DFC,2), UBOUND(InData%DFC,2) + DO i1 = LBOUND(InData%DFC,1), UBOUND(InData%DFC,1) + ReKiBuf(Re_Xferred) = InData%DFC(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%DN) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4160,8 +4237,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DN,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DN)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%DN))-1 ) = PACK(InData%DN,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%DN) + DO i2 = LBOUND(InData%DN,2), UBOUND(InData%DN,2) + DO i1 = LBOUND(InData%DN,1), UBOUND(InData%DN,1) + ReKiBuf(Re_Xferred) = InData%DN(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%DPP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4176,8 +4257,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DPP,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DPP)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%DPP))-1 ) = PACK(InData%DPP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%DPP) + DO i2 = LBOUND(InData%DPP,2), UBOUND(InData%DPP,2) + DO i1 = LBOUND(InData%DPP,1), UBOUND(InData%DPP,1) + ReKiBuf(Re_Xferred) = InData%DPP(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%DQ) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4192,8 +4277,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DQ,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DQ)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%DQ))-1 ) = PACK(InData%DQ,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%DQ) + DO i2 = LBOUND(InData%DQ,2), UBOUND(InData%DQ,2) + DO i1 = LBOUND(InData%DQ,1), UBOUND(InData%DQ,1) + ReKiBuf(Re_Xferred) = InData%DQ(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%DQP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4208,8 +4297,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DQP,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DQP)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%DQP))-1 ) = PACK(InData%DQP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%DQP) + DO i2 = LBOUND(InData%DQP,2), UBOUND(InData%DQP,2) + DO i1 = LBOUND(InData%DQP,1), UBOUND(InData%DQP,1) + ReKiBuf(Re_Xferred) = InData%DQP(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%DQP1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4224,17 +4317,21 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DQP1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DQP1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%DQP1))-1 ) = PACK(InData%DQP1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%DQP1) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DS - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%FK - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%FP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%FPC - Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(InData%DQP1,2), UBOUND(InData%DQP1,2) + DO i1 = LBOUND(InData%DQP1,1), UBOUND(InData%DQP1,1) + ReKiBuf(Re_Xferred) = InData%DQP1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + ReKiBuf(Re_Xferred) = InData%DS + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FK + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FPC + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%FSP) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4248,8 +4345,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FSP,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FSP)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FSP))-1 ) = PACK(InData%FSP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FSP) + DO i2 = LBOUND(InData%FSP,2), UBOUND(InData%FSP,2) + DO i1 = LBOUND(InData%FSP,1), UBOUND(InData%FSP,1) + ReKiBuf(Re_Xferred) = InData%FSP(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%FSP1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4264,8 +4365,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FSP1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FSP1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FSP1))-1 ) = PACK(InData%FSP1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FSP1) + DO i2 = LBOUND(InData%FSP1,2), UBOUND(InData%FSP1,2) + DO i1 = LBOUND(InData%FSP1,1), UBOUND(InData%FSP1,1) + ReKiBuf(Re_Xferred) = InData%FSP1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%FSPC) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4280,8 +4385,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FSPC,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FSPC)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FSPC))-1 ) = PACK(InData%FSPC,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FSPC) + DO i2 = LBOUND(InData%FSPC,2), UBOUND(InData%FSPC,2) + DO i1 = LBOUND(InData%FSPC,1), UBOUND(InData%FSPC,1) + ReKiBuf(Re_Xferred) = InData%FSPC(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%FSPC1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4296,8 +4405,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FSPC1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FSPC1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FSPC1))-1 ) = PACK(InData%FSPC1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FSPC1) + DO i2 = LBOUND(InData%FSPC1,2), UBOUND(InData%FSPC1,2) + DO i1 = LBOUND(InData%FSPC1,1), UBOUND(InData%FSPC1,1) + ReKiBuf(Re_Xferred) = InData%FSPC1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%FTB) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4315,8 +4428,14 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FTB,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FTB)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FTB))-1 ) = PACK(InData%FTB,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FTB) + DO i3 = LBOUND(InData%FTB,3), UBOUND(InData%FTB,3) + DO i2 = LBOUND(InData%FTB,2), UBOUND(InData%FTB,2) + DO i1 = LBOUND(InData%FTB,1), UBOUND(InData%FTB,1) + ReKiBuf(Re_Xferred) = InData%FTB(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%FTBC) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4334,8 +4453,14 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FTBC,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FTBC)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FTBC))-1 ) = PACK(InData%FTBC,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FTBC) + DO i3 = LBOUND(InData%FTBC,3), UBOUND(InData%FTBC,3) + DO i2 = LBOUND(InData%FTBC,2), UBOUND(InData%FTBC,2) + DO i1 = LBOUND(InData%FTBC,1), UBOUND(InData%FTBC,1) + ReKiBuf(Re_Xferred) = InData%FTBC(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%OLDCNV) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4350,8 +4475,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDCNV,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%OLDCNV)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%OLDCNV))-1 ) = PACK(InData%OLDCNV,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%OLDCNV) + DO i2 = LBOUND(InData%OLDCNV,2), UBOUND(InData%OLDCNV,2) + DO i1 = LBOUND(InData%OLDCNV,1), UBOUND(InData%OLDCNV,1) + ReKiBuf(Re_Xferred) = InData%OLDCNV(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%OLDDF) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4366,8 +4495,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDDF,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%OLDDF)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%OLDDF))-1 ) = PACK(InData%OLDDF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%OLDDF) + DO i2 = LBOUND(InData%OLDDF,2), UBOUND(InData%OLDDF,2) + DO i1 = LBOUND(InData%OLDDF,1), UBOUND(InData%OLDDF,1) + ReKiBuf(Re_Xferred) = InData%OLDDF(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%OLDDFC) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4382,8 +4515,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDDFC,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%OLDDFC)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%OLDDFC))-1 ) = PACK(InData%OLDDFC,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%OLDDFC) + DO i2 = LBOUND(InData%OLDDFC,2), UBOUND(InData%OLDDFC,2) + DO i1 = LBOUND(InData%OLDDFC,1), UBOUND(InData%OLDDFC,1) + ReKiBuf(Re_Xferred) = InData%OLDDFC(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%OLDDN) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4398,8 +4535,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDDN,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%OLDDN)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%OLDDN))-1 ) = PACK(InData%OLDDN,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%OLDDN) + DO i2 = LBOUND(InData%OLDDN,2), UBOUND(InData%OLDDN,2) + DO i1 = LBOUND(InData%OLDDN,1), UBOUND(InData%OLDDN,1) + ReKiBuf(Re_Xferred) = InData%OLDDN(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%OLDDPP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4414,8 +4555,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDDPP,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%OLDDPP)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%OLDDPP))-1 ) = PACK(InData%OLDDPP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%OLDDPP) + DO i2 = LBOUND(InData%OLDDPP,2), UBOUND(InData%OLDDPP,2) + DO i1 = LBOUND(InData%OLDDPP,1), UBOUND(InData%OLDDPP,1) + ReKiBuf(Re_Xferred) = InData%OLDDPP(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%OLDDQ) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4430,8 +4575,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDDQ,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%OLDDQ)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%OLDDQ))-1 ) = PACK(InData%OLDDQ,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%OLDDQ) + DO i2 = LBOUND(InData%OLDDQ,2), UBOUND(InData%OLDDQ,2) + DO i1 = LBOUND(InData%OLDDQ,1), UBOUND(InData%OLDDQ,1) + ReKiBuf(Re_Xferred) = InData%OLDDQ(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%OLDTAU) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4446,8 +4595,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDTAU,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%OLDTAU)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%OLDTAU))-1 ) = PACK(InData%OLDTAU,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%OLDTAU) + DO i2 = LBOUND(InData%OLDTAU,2), UBOUND(InData%OLDTAU,2) + DO i1 = LBOUND(InData%OLDTAU,1), UBOUND(InData%OLDTAU,1) + ReKiBuf(Re_Xferred) = InData%OLDTAU(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%OLDXN) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4462,8 +4615,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDXN,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%OLDXN)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%OLDXN))-1 ) = PACK(InData%OLDXN,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%OLDXN) + DO i2 = LBOUND(InData%OLDXN,2), UBOUND(InData%OLDXN,2) + DO i1 = LBOUND(InData%OLDXN,1), UBOUND(InData%OLDXN,1) + ReKiBuf(Re_Xferred) = InData%OLDXN(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%OLDYN) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4478,8 +4635,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLDYN,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%OLDYN)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%OLDYN))-1 ) = PACK(InData%OLDYN,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%OLDYN) + DO i2 = LBOUND(InData%OLDYN,2), UBOUND(InData%OLDYN,2) + DO i1 = LBOUND(InData%OLDYN,1), UBOUND(InData%OLDYN,1) + ReKiBuf(Re_Xferred) = InData%OLDYN(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%QX) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4494,8 +4655,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QX,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%QX)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%QX))-1 ) = PACK(InData%QX,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%QX) + DO i2 = LBOUND(InData%QX,2), UBOUND(InData%QX,2) + DO i1 = LBOUND(InData%QX,1), UBOUND(InData%QX,1) + ReKiBuf(Re_Xferred) = InData%QX(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%QX1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4510,8 +4675,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QX1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%QX1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%QX1))-1 ) = PACK(InData%QX1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%QX1) + DO i2 = LBOUND(InData%QX1,2), UBOUND(InData%QX1,2) + DO i1 = LBOUND(InData%QX1,1), UBOUND(InData%QX1,1) + ReKiBuf(Re_Xferred) = InData%QX1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%TAU) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4526,8 +4695,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TAU,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TAU)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TAU))-1 ) = PACK(InData%TAU,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TAU) + DO i2 = LBOUND(InData%TAU,2), UBOUND(InData%TAU,2) + DO i1 = LBOUND(InData%TAU,1), UBOUND(InData%TAU,1) + ReKiBuf(Re_Xferred) = InData%TAU(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%XN) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4542,8 +4715,12 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%XN,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%XN)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%XN))-1 ) = PACK(InData%XN,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%XN) + DO i2 = LBOUND(InData%XN,2), UBOUND(InData%XN,2) + DO i1 = LBOUND(InData%XN,1), UBOUND(InData%XN,1) + ReKiBuf(Re_Xferred) = InData%XN(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%YN) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4558,13 +4735,17 @@ SUBROUTINE AD14_PackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%YN,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%YN)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%YN))-1 ) = PACK(InData%YN,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%YN) + DO i2 = LBOUND(InData%YN,2), UBOUND(InData%YN,2) + DO i1 = LBOUND(InData%YN,1), UBOUND(InData%YN,1) + ReKiBuf(Re_Xferred) = InData%YN(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%SHIFT , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%VOR , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%SHIFT, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%VOR, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE AD14_PackBeddoes SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -4580,12 +4761,6 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (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 @@ -4618,15 +4793,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ADOT.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%ADOT)>0) OutData%ADOT = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%ADOT))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%ADOT) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%ADOT,2), UBOUND(OutData%ADOT,2) + DO i1 = LBOUND(OutData%ADOT,1), UBOUND(OutData%ADOT,1) + OutData%ADOT(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ADOT1 not allocated Int_Xferred = Int_Xferred + 1 @@ -4644,15 +4816,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ADOT1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%ADOT1)>0) OutData%ADOT1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%ADOT1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%ADOT1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%ADOT1,2), UBOUND(OutData%ADOT1,2) + DO i1 = LBOUND(OutData%ADOT1,1), UBOUND(OutData%ADOT1,1) + OutData%ADOT1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AFE not allocated Int_Xferred = Int_Xferred + 1 @@ -4670,15 +4839,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%AFE)>0) OutData%AFE = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AFE))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AFE) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AFE,2), UBOUND(OutData%AFE,2) + DO i1 = LBOUND(OutData%AFE,1), UBOUND(OutData%AFE,1) + OutData%AFE(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AFE1 not allocated Int_Xferred = Int_Xferred + 1 @@ -4696,18 +4862,15 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AFE1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%AFE1)>0) OutData%AFE1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AFE1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AFE1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AFE1,2), UBOUND(OutData%AFE1,2) + DO i1 = LBOUND(OutData%AFE1,1), UBOUND(OutData%AFE1,1) + OutData%AFE1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - OutData%AN = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%AN = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ANE not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -4724,15 +4887,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ANE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%ANE)>0) OutData%ANE = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%ANE))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%ANE) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%ANE,2), UBOUND(OutData%ANE,2) + DO i1 = LBOUND(OutData%ANE,1), UBOUND(OutData%ANE,1) + OutData%ANE(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ANE1 not allocated Int_Xferred = Int_Xferred + 1 @@ -4750,15 +4910,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ANE1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%ANE1)>0) OutData%ANE1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%ANE1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%ANE1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%ANE1,2), UBOUND(OutData%ANE1,2) + DO i1 = LBOUND(OutData%ANE1,1), UBOUND(OutData%ANE1,1) + OutData%ANE1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AOD not allocated Int_Xferred = Int_Xferred + 1 @@ -4776,15 +4933,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AOD.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%AOD)>0) OutData%AOD = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AOD))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AOD) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AOD,2), UBOUND(OutData%AOD,2) + DO i1 = LBOUND(OutData%AOD,1), UBOUND(OutData%AOD,1) + OutData%AOD(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AOL not allocated Int_Xferred = Int_Xferred + 1 @@ -4802,15 +4956,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AOL.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%AOL)>0) OutData%AOL = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AOL))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AOL) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AOL,2), UBOUND(OutData%AOL,2) + DO i1 = LBOUND(OutData%AOL,1), UBOUND(OutData%AOL,1) + OutData%AOL(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BEDSEP not allocated Int_Xferred = Int_Xferred + 1 @@ -4828,15 +4979,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BEDSEP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%BEDSEP)>0) OutData%BEDSEP = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%BEDSEP))-1 ), OutData%BEDSEP), mask2,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%BEDSEP) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%BEDSEP,2), UBOUND(OutData%BEDSEP,2) + DO i1 = LBOUND(OutData%BEDSEP,1), UBOUND(OutData%BEDSEP,1) + OutData%BEDSEP(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%BEDSEP(i1,i2)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLDSEP not allocated Int_Xferred = Int_Xferred + 1 @@ -4854,18 +5002,15 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDSEP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%OLDSEP)>0) OutData%OLDSEP = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%OLDSEP))-1 ), OutData%OLDSEP), mask2,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%OLDSEP) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%OLDSEP,2), UBOUND(OutData%OLDSEP,2) + DO i1 = LBOUND(OutData%OLDSEP,1), UBOUND(OutData%OLDSEP,1) + OutData%OLDSEP(i1,i2) = TRANSFER(IntKiBuf(Int_Xferred), OutData%OLDSEP(i1,i2)) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF - OutData%CC = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%CC = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CDO not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -4882,22 +5027,19 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CDO.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%CDO)>0) OutData%CDO = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CDO))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CDO) - DEALLOCATE(mask2) - END IF - OutData%CMI = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%CMQ = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%CN = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(OutData%CDO,2), UBOUND(OutData%CDO,2) + DO i1 = LBOUND(OutData%CDO,1), UBOUND(OutData%CDO,1) + OutData%CDO(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%CMI = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%CMQ = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%CN = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CNA not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -4914,20 +5056,17 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNA.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%CNA)>0) OutData%CNA = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CNA))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CNA) - DEALLOCATE(mask2) - END IF - OutData%CNCP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%CNIQ = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(OutData%CNA,2), UBOUND(OutData%CNA,2) + DO i1 = LBOUND(OutData%CNA,1), UBOUND(OutData%CNA,1) + OutData%CNA(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%CNCP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%CNIQ = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CNP not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -4944,15 +5083,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%CNP)>0) OutData%CNP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CNP))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CNP) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%CNP,2), UBOUND(OutData%CNP,2) + DO i1 = LBOUND(OutData%CNP,1), UBOUND(OutData%CNP,1) + OutData%CNP(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CNP1 not allocated Int_Xferred = Int_Xferred + 1 @@ -4970,15 +5106,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNP1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%CNP1)>0) OutData%CNP1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CNP1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CNP1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%CNP1,2), UBOUND(OutData%CNP1,2) + DO i1 = LBOUND(OutData%CNP1,1), UBOUND(OutData%CNP1,1) + OutData%CNP1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CNPD not allocated Int_Xferred = Int_Xferred + 1 @@ -4996,15 +5129,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNPD.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%CNPD)>0) OutData%CNPD = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CNPD))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CNPD) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%CNPD,2), UBOUND(OutData%CNPD,2) + DO i1 = LBOUND(OutData%CNPD,1), UBOUND(OutData%CNPD,1) + OutData%CNPD(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CNPD1 not allocated Int_Xferred = Int_Xferred + 1 @@ -5022,15 +5152,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNPD1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%CNPD1)>0) OutData%CNPD1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CNPD1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CNPD1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%CNPD1,2), UBOUND(OutData%CNPD1,2) + DO i1 = LBOUND(OutData%CNPD1,1), UBOUND(OutData%CNPD1,1) + OutData%CNPD1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CNPOT not allocated Int_Xferred = Int_Xferred + 1 @@ -5048,15 +5175,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNPOT.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%CNPOT)>0) OutData%CNPOT = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CNPOT))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CNPOT) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%CNPOT,2), UBOUND(OutData%CNPOT,2) + DO i1 = LBOUND(OutData%CNPOT,1), UBOUND(OutData%CNPOT,1) + OutData%CNPOT(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CNPOT1 not allocated Int_Xferred = Int_Xferred + 1 @@ -5074,15 +5198,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNPOT1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%CNPOT1)>0) OutData%CNPOT1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CNPOT1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CNPOT1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%CNPOT1,2), UBOUND(OutData%CNPOT1,2) + DO i1 = LBOUND(OutData%CNPOT1,1), UBOUND(OutData%CNPOT1,1) + OutData%CNPOT1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CNS not allocated Int_Xferred = Int_Xferred + 1 @@ -5100,15 +5221,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNS.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%CNS)>0) OutData%CNS = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CNS))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CNS) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%CNS,2), UBOUND(OutData%CNS,2) + DO i1 = LBOUND(OutData%CNS,1), UBOUND(OutData%CNS,1) + OutData%CNS(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CNSL not allocated Int_Xferred = Int_Xferred + 1 @@ -5126,15 +5244,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNSL.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%CNSL)>0) OutData%CNSL = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CNSL))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CNSL) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%CNSL,2), UBOUND(OutData%CNSL,2) + DO i1 = LBOUND(OutData%CNSL,1), UBOUND(OutData%CNSL,1) + OutData%CNSL(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CNV not allocated Int_Xferred = Int_Xferred + 1 @@ -5152,15 +5267,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNV.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%CNV)>0) OutData%CNV = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CNV))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CNV) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%CNV,2), UBOUND(OutData%CNV,2) + DO i1 = LBOUND(OutData%CNV,1), UBOUND(OutData%CNV,1) + OutData%CNV(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CVN not allocated Int_Xferred = Int_Xferred + 1 @@ -5178,15 +5290,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CVN.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%CVN)>0) OutData%CVN = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CVN))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CVN) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%CVN,2), UBOUND(OutData%CVN,2) + DO i1 = LBOUND(OutData%CVN,1), UBOUND(OutData%CVN,1) + OutData%CVN(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CVN1 not allocated Int_Xferred = Int_Xferred + 1 @@ -5204,15 +5313,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CVN1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%CVN1)>0) OutData%CVN1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CVN1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CVN1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%CVN1,2), UBOUND(OutData%CVN1,2) + DO i1 = LBOUND(OutData%CVN1,1), UBOUND(OutData%CVN1,1) + OutData%CVN1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DF not allocated Int_Xferred = Int_Xferred + 1 @@ -5230,15 +5336,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DF.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%DF)>0) OutData%DF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%DF))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%DF) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%DF,2), UBOUND(OutData%DF,2) + DO i1 = LBOUND(OutData%DF,1), UBOUND(OutData%DF,1) + OutData%DF(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DFAFE not allocated Int_Xferred = Int_Xferred + 1 @@ -5256,15 +5359,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DFAFE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%DFAFE)>0) OutData%DFAFE = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%DFAFE))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%DFAFE) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%DFAFE,2), UBOUND(OutData%DFAFE,2) + DO i1 = LBOUND(OutData%DFAFE,1), UBOUND(OutData%DFAFE,1) + OutData%DFAFE(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DFAFE1 not allocated Int_Xferred = Int_Xferred + 1 @@ -5282,15 +5382,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DFAFE1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%DFAFE1)>0) OutData%DFAFE1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%DFAFE1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%DFAFE1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%DFAFE1,2), UBOUND(OutData%DFAFE1,2) + DO i1 = LBOUND(OutData%DFAFE1,1), UBOUND(OutData%DFAFE1,1) + OutData%DFAFE1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DFC not allocated Int_Xferred = Int_Xferred + 1 @@ -5308,15 +5405,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DFC.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%DFC)>0) OutData%DFC = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%DFC))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%DFC) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%DFC,2), UBOUND(OutData%DFC,2) + DO i1 = LBOUND(OutData%DFC,1), UBOUND(OutData%DFC,1) + OutData%DFC(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DN not allocated Int_Xferred = Int_Xferred + 1 @@ -5334,15 +5428,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DN.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%DN)>0) OutData%DN = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%DN))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%DN) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%DN,2), UBOUND(OutData%DN,2) + DO i1 = LBOUND(OutData%DN,1), UBOUND(OutData%DN,1) + OutData%DN(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DPP not allocated Int_Xferred = Int_Xferred + 1 @@ -5360,15 +5451,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DPP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%DPP)>0) OutData%DPP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%DPP))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%DPP) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%DPP,2), UBOUND(OutData%DPP,2) + DO i1 = LBOUND(OutData%DPP,1), UBOUND(OutData%DPP,1) + OutData%DPP(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DQ not allocated Int_Xferred = Int_Xferred + 1 @@ -5386,15 +5474,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DQ.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%DQ)>0) OutData%DQ = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%DQ))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%DQ) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%DQ,2), UBOUND(OutData%DQ,2) + DO i1 = LBOUND(OutData%DQ,1), UBOUND(OutData%DQ,1) + OutData%DQ(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DQP not allocated Int_Xferred = Int_Xferred + 1 @@ -5412,15 +5497,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DQP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%DQP)>0) OutData%DQP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%DQP))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%DQP) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%DQP,2), UBOUND(OutData%DQP,2) + DO i1 = LBOUND(OutData%DQP,1), UBOUND(OutData%DQP,1) + OutData%DQP(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DQP1 not allocated Int_Xferred = Int_Xferred + 1 @@ -5438,24 +5520,21 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DQP1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%DQP1)>0) OutData%DQP1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%DQP1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%DQP1) - DEALLOCATE(mask2) - END IF - OutData%DS = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%FK = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%FP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%FPC = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(OutData%DQP1,2), UBOUND(OutData%DQP1,2) + DO i1 = LBOUND(OutData%DQP1,1), UBOUND(OutData%DQP1,1) + OutData%DQP1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%DS = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%FK = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%FP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%FPC = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FSP not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5472,15 +5551,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FSP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%FSP)>0) OutData%FSP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FSP))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FSP) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%FSP,2), UBOUND(OutData%FSP,2) + DO i1 = LBOUND(OutData%FSP,1), UBOUND(OutData%FSP,1) + OutData%FSP(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FSP1 not allocated Int_Xferred = Int_Xferred + 1 @@ -5498,15 +5574,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FSP1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%FSP1)>0) OutData%FSP1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FSP1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FSP1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%FSP1,2), UBOUND(OutData%FSP1,2) + DO i1 = LBOUND(OutData%FSP1,1), UBOUND(OutData%FSP1,1) + OutData%FSP1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FSPC not allocated Int_Xferred = Int_Xferred + 1 @@ -5524,15 +5597,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FSPC.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%FSPC)>0) OutData%FSPC = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FSPC))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FSPC) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%FSPC,2), UBOUND(OutData%FSPC,2) + DO i1 = LBOUND(OutData%FSPC,1), UBOUND(OutData%FSPC,1) + OutData%FSPC(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FSPC1 not allocated Int_Xferred = Int_Xferred + 1 @@ -5550,15 +5620,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FSPC1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%FSPC1)>0) OutData%FSPC1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FSPC1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FSPC1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%FSPC1,2), UBOUND(OutData%FSPC1,2) + DO i1 = LBOUND(OutData%FSPC1,1), UBOUND(OutData%FSPC1,1) + OutData%FSPC1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FTB not allocated Int_Xferred = Int_Xferred + 1 @@ -5579,15 +5646,14 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FTB.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%FTB)>0) OutData%FTB = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FTB))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FTB) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%FTB,3), UBOUND(OutData%FTB,3) + DO i2 = LBOUND(OutData%FTB,2), UBOUND(OutData%FTB,2) + DO i1 = LBOUND(OutData%FTB,1), UBOUND(OutData%FTB,1) + OutData%FTB(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FTBC not allocated Int_Xferred = Int_Xferred + 1 @@ -5608,15 +5674,14 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FTBC.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%FTBC)>0) OutData%FTBC = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FTBC))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FTBC) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%FTBC,3), UBOUND(OutData%FTBC,3) + DO i2 = LBOUND(OutData%FTBC,2), UBOUND(OutData%FTBC,2) + DO i1 = LBOUND(OutData%FTBC,1), UBOUND(OutData%FTBC,1) + OutData%FTBC(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLDCNV not allocated Int_Xferred = Int_Xferred + 1 @@ -5634,15 +5699,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDCNV.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%OLDCNV)>0) OutData%OLDCNV = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%OLDCNV))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%OLDCNV) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%OLDCNV,2), UBOUND(OutData%OLDCNV,2) + DO i1 = LBOUND(OutData%OLDCNV,1), UBOUND(OutData%OLDCNV,1) + OutData%OLDCNV(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLDDF not allocated Int_Xferred = Int_Xferred + 1 @@ -5660,15 +5722,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDDF.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%OLDDF)>0) OutData%OLDDF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%OLDDF))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%OLDDF) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%OLDDF,2), UBOUND(OutData%OLDDF,2) + DO i1 = LBOUND(OutData%OLDDF,1), UBOUND(OutData%OLDDF,1) + OutData%OLDDF(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLDDFC not allocated Int_Xferred = Int_Xferred + 1 @@ -5686,15 +5745,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDDFC.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%OLDDFC)>0) OutData%OLDDFC = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%OLDDFC))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%OLDDFC) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%OLDDFC,2), UBOUND(OutData%OLDDFC,2) + DO i1 = LBOUND(OutData%OLDDFC,1), UBOUND(OutData%OLDDFC,1) + OutData%OLDDFC(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLDDN not allocated Int_Xferred = Int_Xferred + 1 @@ -5712,15 +5768,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDDN.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%OLDDN)>0) OutData%OLDDN = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%OLDDN))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%OLDDN) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%OLDDN,2), UBOUND(OutData%OLDDN,2) + DO i1 = LBOUND(OutData%OLDDN,1), UBOUND(OutData%OLDDN,1) + OutData%OLDDN(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLDDPP not allocated Int_Xferred = Int_Xferred + 1 @@ -5738,15 +5791,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDDPP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%OLDDPP)>0) OutData%OLDDPP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%OLDDPP))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%OLDDPP) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%OLDDPP,2), UBOUND(OutData%OLDDPP,2) + DO i1 = LBOUND(OutData%OLDDPP,1), UBOUND(OutData%OLDDPP,1) + OutData%OLDDPP(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLDDQ not allocated Int_Xferred = Int_Xferred + 1 @@ -5764,15 +5814,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDDQ.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%OLDDQ)>0) OutData%OLDDQ = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%OLDDQ))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%OLDDQ) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%OLDDQ,2), UBOUND(OutData%OLDDQ,2) + DO i1 = LBOUND(OutData%OLDDQ,1), UBOUND(OutData%OLDDQ,1) + OutData%OLDDQ(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLDTAU not allocated Int_Xferred = Int_Xferred + 1 @@ -5790,15 +5837,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDTAU.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%OLDTAU)>0) OutData%OLDTAU = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%OLDTAU))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%OLDTAU) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%OLDTAU,2), UBOUND(OutData%OLDTAU,2) + DO i1 = LBOUND(OutData%OLDTAU,1), UBOUND(OutData%OLDTAU,1) + OutData%OLDTAU(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLDXN not allocated Int_Xferred = Int_Xferred + 1 @@ -5816,15 +5860,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDXN.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%OLDXN)>0) OutData%OLDXN = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%OLDXN))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%OLDXN) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%OLDXN,2), UBOUND(OutData%OLDXN,2) + DO i1 = LBOUND(OutData%OLDXN,1), UBOUND(OutData%OLDXN,1) + OutData%OLDXN(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLDYN not allocated Int_Xferred = Int_Xferred + 1 @@ -5842,15 +5883,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLDYN.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%OLDYN)>0) OutData%OLDYN = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%OLDYN))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%OLDYN) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%OLDYN,2), UBOUND(OutData%OLDYN,2) + DO i1 = LBOUND(OutData%OLDYN,1), UBOUND(OutData%OLDYN,1) + OutData%OLDYN(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QX not allocated Int_Xferred = Int_Xferred + 1 @@ -5868,15 +5906,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%QX.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%QX)>0) OutData%QX = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%QX))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%QX) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%QX,2), UBOUND(OutData%QX,2) + DO i1 = LBOUND(OutData%QX,1), UBOUND(OutData%QX,1) + OutData%QX(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QX1 not allocated Int_Xferred = Int_Xferred + 1 @@ -5894,15 +5929,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%QX1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%QX1)>0) OutData%QX1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%QX1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%QX1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%QX1,2), UBOUND(OutData%QX1,2) + DO i1 = LBOUND(OutData%QX1,1), UBOUND(OutData%QX1,1) + OutData%QX1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TAU not allocated Int_Xferred = Int_Xferred + 1 @@ -5920,15 +5952,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TAU.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%TAU)>0) OutData%TAU = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TAU))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TAU) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%TAU,2), UBOUND(OutData%TAU,2) + DO i1 = LBOUND(OutData%TAU,1), UBOUND(OutData%TAU,1) + OutData%TAU(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! XN not allocated Int_Xferred = Int_Xferred + 1 @@ -5946,15 +5975,12 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%XN.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%XN)>0) OutData%XN = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%XN))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%XN) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%XN,2), UBOUND(OutData%XN,2) + DO i1 = LBOUND(OutData%XN,1), UBOUND(OutData%XN,1) + OutData%XN(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! YN not allocated Int_Xferred = Int_Xferred + 1 @@ -5972,20 +5998,17 @@ SUBROUTINE AD14_UnPackBeddoes( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%YN.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%YN)>0) OutData%YN = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%YN))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%YN) - DEALLOCATE(mask2) - END IF - OutData%SHIFT = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%VOR = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(OutData%YN,2), UBOUND(OutData%YN,2) + DO i1 = LBOUND(OutData%YN,1), UBOUND(OutData%YN,1) + OutData%YN(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%SHIFT = TRANSFER(IntKiBuf(Int_Xferred), OutData%SHIFT) + Int_Xferred = Int_Xferred + 1 + OutData%VOR = TRANSFER(IntKiBuf(Int_Xferred), OutData%VOR) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE AD14_UnPackBeddoes SUBROUTINE AD14_CopyBeddoesParms( SrcBeddoesParmsData, DstBeddoesParmsData, CtrlCode, ErrStat, ErrMsg ) @@ -6087,16 +6110,16 @@ SUBROUTINE AD14_PackBeddoesParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AS - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TF - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TV - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TVL - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AS + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TF + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TV + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TVL + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AD14_PackBeddoesParms SUBROUTINE AD14_UnPackBeddoesParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -6112,12 +6135,6 @@ SUBROUTINE AD14_UnPackBeddoesParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackBeddoesParms' @@ -6131,16 +6148,16 @@ SUBROUTINE AD14_UnPackBeddoesParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%AS = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TF = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TV = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TVL = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%AS = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TF = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TV = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TVL = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AD14_UnPackBeddoesParms SUBROUTINE AD14_CopyBladeParms( SrcBladeParmsData, DstBladeParmsData, CtrlCode, ErrStat, ErrMsg ) @@ -6287,8 +6304,10 @@ SUBROUTINE AD14_PackBladeParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%C)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%C))-1 ) = PACK(InData%C,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%C) + DO i1 = LBOUND(InData%C,1), UBOUND(InData%C,1) + ReKiBuf(Re_Xferred) = InData%C(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%DR) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6300,13 +6319,15 @@ SUBROUTINE AD14_PackBladeParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DR,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DR)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%DR))-1 ) = PACK(InData%DR,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%DR) + DO i1 = LBOUND(InData%DR,1), UBOUND(InData%DR,1) + ReKiBuf(Re_Xferred) = InData%DR(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%R - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%BladeLength - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%R + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%BladeLength + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AD14_PackBladeParms SUBROUTINE AD14_UnPackBladeParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -6322,12 +6343,6 @@ SUBROUTINE AD14_UnPackBladeParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -6355,15 +6370,10 @@ SUBROUTINE AD14_UnPackBladeParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%C)>0) OutData%C = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%C))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%C) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%C,1), UBOUND(OutData%C,1) + OutData%C(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DR not allocated Int_Xferred = Int_Xferred + 1 @@ -6378,20 +6388,15 @@ SUBROUTINE AD14_UnPackBladeParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DR.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%DR)>0) OutData%DR = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%DR))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%DR) - DEALLOCATE(mask1) - END IF - OutData%R = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%BladeLength = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%DR,1), UBOUND(OutData%DR,1) + OutData%DR(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%R = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%BladeLength = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AD14_UnPackBladeParms SUBROUTINE AD14_CopyDynInflow( SrcDynInflowData, DstDynInflowData, CtrlCode, ErrStat, ErrMsg ) @@ -6582,26 +6587,42 @@ SUBROUTINE AD14_PackDynInflow( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%dAlph_dt))-1 ) = PACK(InData%dAlph_dt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%dAlph_dt) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%dBeta_dt))-1 ) = PACK(InData%dBeta_dt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%dBeta_dt) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DTO - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%old_Alph))-1 ) = PACK(InData%old_Alph,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%old_Alph) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%old_Beta))-1 ) = PACK(InData%old_Beta,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%old_Beta) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%old_LmdM - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%oldKai - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PhiLqC))-1 ) = PACK(InData%PhiLqC,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PhiLqC) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PhiLqS))-1 ) = PACK(InData%PhiLqS,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PhiLqS) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Pzero - Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(InData%dAlph_dt,2), UBOUND(InData%dAlph_dt,2) + DO i1 = LBOUND(InData%dAlph_dt,1), UBOUND(InData%dAlph_dt,1) + ReKiBuf(Re_Xferred) = InData%dAlph_dt(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%dBeta_dt,2), UBOUND(InData%dBeta_dt,2) + DO i1 = LBOUND(InData%dBeta_dt,1), UBOUND(InData%dBeta_dt,1) + ReKiBuf(Re_Xferred) = InData%dBeta_dt(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + ReKiBuf(Re_Xferred) = InData%DTO + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%old_Alph,1), UBOUND(InData%old_Alph,1) + ReKiBuf(Re_Xferred) = InData%old_Alph(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%old_Beta,1), UBOUND(InData%old_Beta,1) + ReKiBuf(Re_Xferred) = InData%old_Beta(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%old_LmdM + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%oldKai + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%PhiLqC,1), UBOUND(InData%PhiLqC,1) + ReKiBuf(Re_Xferred) = InData%PhiLqC(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%PhiLqS,1), UBOUND(InData%PhiLqS,1) + ReKiBuf(Re_Xferred) = InData%PhiLqS(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%Pzero + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%RMC_SAVE) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -6618,8 +6639,14 @@ SUBROUTINE AD14_PackDynInflow( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RMC_SAVE,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RMC_SAVE)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RMC_SAVE))-1 ) = PACK(InData%RMC_SAVE,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RMC_SAVE) + DO i3 = LBOUND(InData%RMC_SAVE,3), UBOUND(InData%RMC_SAVE,3) + DO i2 = LBOUND(InData%RMC_SAVE,2), UBOUND(InData%RMC_SAVE,2) + DO i1 = LBOUND(InData%RMC_SAVE,1), UBOUND(InData%RMC_SAVE,1) + ReKiBuf(Re_Xferred) = InData%RMC_SAVE(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%RMS_SAVE) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6637,37 +6664,71 @@ SUBROUTINE AD14_PackDynInflow( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RMS_SAVE,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RMS_SAVE)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RMS_SAVE))-1 ) = PACK(InData%RMS_SAVE,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RMS_SAVE) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TipSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%totalInf - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Vparam - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Vtotal - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%xAlpha))-1 ) = PACK(InData%xAlpha,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%xAlpha) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%xBeta))-1 ) = PACK(InData%xBeta,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%xBeta) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%xKai - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%XLAMBDA_M - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%xLcos))-1 ) = PACK(InData%xLcos,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%xLcos) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%xLsin))-1 ) = PACK(InData%xLsin,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%xLsin) - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%MminR))-1 ) = PACK(InData%MminR,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%MminR) - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%MminusR))-1 ) = PACK(InData%MminusR,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%MminusR) - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%MplusR))-1 ) = PACK(InData%MplusR,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%MplusR) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GAMMA))-1 ) = PACK(InData%GAMMA,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GAMMA) + DO i3 = LBOUND(InData%RMS_SAVE,3), UBOUND(InData%RMS_SAVE,3) + DO i2 = LBOUND(InData%RMS_SAVE,2), UBOUND(InData%RMS_SAVE,2) + DO i1 = LBOUND(InData%RMS_SAVE,1), UBOUND(InData%RMS_SAVE,1) + ReKiBuf(Re_Xferred) = InData%RMS_SAVE(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + ReKiBuf(Re_Xferred) = InData%TipSpeed + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%totalInf + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Vparam + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Vtotal + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%xAlpha,1), UBOUND(InData%xAlpha,1) + ReKiBuf(Re_Xferred) = InData%xAlpha(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%xBeta,1), UBOUND(InData%xBeta,1) + ReKiBuf(Re_Xferred) = InData%xBeta(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%xKai + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%XLAMBDA_M + Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(InData%xLcos,2), UBOUND(InData%xLcos,2) + DO i1 = LBOUND(InData%xLcos,1), UBOUND(InData%xLcos,1) + ReKiBuf(Re_Xferred) = InData%xLcos(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%xLsin,2), UBOUND(InData%xLsin,2) + DO i1 = LBOUND(InData%xLsin,1), UBOUND(InData%xLsin,1) + ReKiBuf(Re_Xferred) = InData%xLsin(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%MminR,2), UBOUND(InData%MminR,2) + DO i1 = LBOUND(InData%MminR,1), UBOUND(InData%MminR,1) + IntKiBuf(Int_Xferred) = InData%MminR(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%MminusR,2), UBOUND(InData%MminusR,2) + DO i1 = LBOUND(InData%MminusR,1), UBOUND(InData%MminusR,1) + IntKiBuf(Int_Xferred) = InData%MminusR(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%MplusR,2), UBOUND(InData%MplusR,2) + DO i1 = LBOUND(InData%MplusR,1), UBOUND(InData%MplusR,1) + IntKiBuf(Int_Xferred) = InData%MplusR(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%GAMMA,2), UBOUND(InData%GAMMA,2) + DO i1 = LBOUND(InData%GAMMA,1), UBOUND(InData%GAMMA,1) + ReKiBuf(Re_Xferred) = InData%GAMMA(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END SUBROUTINE AD14_PackDynInflow SUBROUTINE AD14_UnPackDynInflow( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -6683,12 +6744,6 @@ SUBROUTINE AD14_UnPackDynInflow( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (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 @@ -6709,80 +6764,54 @@ SUBROUTINE AD14_UnPackDynInflow( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E i1_u = UBOUND(OutData%dAlph_dt,1) i2_l = LBOUND(OutData%dAlph_dt,2) i2_u = UBOUND(OutData%dAlph_dt,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%dAlph_dt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%dAlph_dt))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%dAlph_dt) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%dAlph_dt,2), UBOUND(OutData%dAlph_dt,2) + DO i1 = LBOUND(OutData%dAlph_dt,1), UBOUND(OutData%dAlph_dt,1) + OutData%dAlph_dt(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%dBeta_dt,1) i1_u = UBOUND(OutData%dBeta_dt,1) i2_l = LBOUND(OutData%dBeta_dt,2) i2_u = UBOUND(OutData%dBeta_dt,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%dBeta_dt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%dBeta_dt))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%dBeta_dt) - DEALLOCATE(mask2) - OutData%DTO = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(OutData%dBeta_dt,2), UBOUND(OutData%dBeta_dt,2) + DO i1 = LBOUND(OutData%dBeta_dt,1), UBOUND(OutData%dBeta_dt,1) + OutData%dBeta_dt(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + OutData%DTO = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%old_Alph,1) i1_u = UBOUND(OutData%old_Alph,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%old_Alph = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%old_Alph))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%old_Alph) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%old_Alph,1), UBOUND(OutData%old_Alph,1) + OutData%old_Alph(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%old_Beta,1) i1_u = UBOUND(OutData%old_Beta,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%old_Beta = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%old_Beta))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%old_Beta) - DEALLOCATE(mask1) - OutData%old_LmdM = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%oldKai = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%old_Beta,1), UBOUND(OutData%old_Beta,1) + OutData%old_Beta(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%old_LmdM = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%oldKai = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%PhiLqC,1) i1_u = UBOUND(OutData%PhiLqC,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%PhiLqC = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PhiLqC))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PhiLqC) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%PhiLqC,1), UBOUND(OutData%PhiLqC,1) + OutData%PhiLqC(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%PhiLqS,1) i1_u = UBOUND(OutData%PhiLqS,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%PhiLqS = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PhiLqS))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PhiLqS) - DEALLOCATE(mask1) - OutData%Pzero = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%PhiLqS,1), UBOUND(OutData%PhiLqS,1) + OutData%PhiLqS(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%Pzero = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RMC_SAVE not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -6802,15 +6831,14 @@ SUBROUTINE AD14_UnPackDynInflow( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RMC_SAVE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%RMC_SAVE)>0) OutData%RMC_SAVE = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RMC_SAVE))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RMC_SAVE) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%RMC_SAVE,3), UBOUND(OutData%RMC_SAVE,3) + DO i2 = LBOUND(OutData%RMC_SAVE,2), UBOUND(OutData%RMC_SAVE,2) + DO i1 = LBOUND(OutData%RMC_SAVE,1), UBOUND(OutData%RMC_SAVE,1) + OutData%RMC_SAVE(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RMS_SAVE not allocated Int_Xferred = Int_Xferred + 1 @@ -6831,128 +6859,99 @@ SUBROUTINE AD14_UnPackDynInflow( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RMS_SAVE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%RMS_SAVE)>0) OutData%RMS_SAVE = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RMS_SAVE))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RMS_SAVE) - DEALLOCATE(mask3) - END IF - OutData%TipSpeed = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%totalInf = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Vparam = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Vtotal = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i3 = LBOUND(OutData%RMS_SAVE,3), UBOUND(OutData%RMS_SAVE,3) + DO i2 = LBOUND(OutData%RMS_SAVE,2), UBOUND(OutData%RMS_SAVE,2) + DO i1 = LBOUND(OutData%RMS_SAVE,1), UBOUND(OutData%RMS_SAVE,1) + OutData%RMS_SAVE(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + OutData%TipSpeed = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%totalInf = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Vparam = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Vtotal = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%xAlpha,1) i1_u = UBOUND(OutData%xAlpha,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%xAlpha = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%xAlpha))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%xAlpha) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%xAlpha,1), UBOUND(OutData%xAlpha,1) + OutData%xAlpha(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%xBeta,1) i1_u = UBOUND(OutData%xBeta,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%xBeta = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%xBeta))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%xBeta) - DEALLOCATE(mask1) - OutData%xKai = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%XLAMBDA_M = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%xBeta,1), UBOUND(OutData%xBeta,1) + OutData%xBeta(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%xKai = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%XLAMBDA_M = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%xLcos,1) i1_u = UBOUND(OutData%xLcos,1) i2_l = LBOUND(OutData%xLcos,2) i2_u = UBOUND(OutData%xLcos,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%xLcos = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%xLcos))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%xLcos) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%xLcos,2), UBOUND(OutData%xLcos,2) + DO i1 = LBOUND(OutData%xLcos,1), UBOUND(OutData%xLcos,1) + OutData%xLcos(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%xLsin,1) i1_u = UBOUND(OutData%xLsin,1) i2_l = LBOUND(OutData%xLsin,2) i2_u = UBOUND(OutData%xLsin,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%xLsin = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%xLsin))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%xLsin) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%xLsin,2), UBOUND(OutData%xLsin,2) + DO i1 = LBOUND(OutData%xLsin,1), UBOUND(OutData%xLsin,1) + OutData%xLsin(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%MminR,1) i1_u = UBOUND(OutData%MminR,1) i2_l = LBOUND(OutData%MminR,2) i2_u = UBOUND(OutData%MminR,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%MminR = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%MminR))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%MminR) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%MminR,2), UBOUND(OutData%MminR,2) + DO i1 = LBOUND(OutData%MminR,1), UBOUND(OutData%MminR,1) + OutData%MminR(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%MminusR,1) i1_u = UBOUND(OutData%MminusR,1) i2_l = LBOUND(OutData%MminusR,2) i2_u = UBOUND(OutData%MminusR,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%MminusR = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%MminusR))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%MminusR) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%MminusR,2), UBOUND(OutData%MminusR,2) + DO i1 = LBOUND(OutData%MminusR,1), UBOUND(OutData%MminusR,1) + OutData%MminusR(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%MplusR,1) i1_u = UBOUND(OutData%MplusR,1) i2_l = LBOUND(OutData%MplusR,2) i2_u = UBOUND(OutData%MplusR,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%MplusR = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%MplusR))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%MplusR) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%MplusR,2), UBOUND(OutData%MplusR,2) + DO i1 = LBOUND(OutData%MplusR,1), UBOUND(OutData%MplusR,1) + OutData%MplusR(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%GAMMA,1) i1_u = UBOUND(OutData%GAMMA,1) i2_l = LBOUND(OutData%GAMMA,2) i2_u = UBOUND(OutData%GAMMA,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%GAMMA = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GAMMA))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GAMMA) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%GAMMA,2), UBOUND(OutData%GAMMA,2) + DO i1 = LBOUND(OutData%GAMMA,1), UBOUND(OutData%GAMMA,1) + OutData%GAMMA(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END SUBROUTINE AD14_UnPackDynInflow SUBROUTINE AD14_CopyDynInflowParms( SrcDynInflowParmsData, DstDynInflowParmsData, CtrlCode, ErrStat, ErrMsg ) @@ -7049,10 +7048,12 @@ SUBROUTINE AD14_PackDynInflowParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MAXINFLO - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%xMinv))-1 ) = PACK(InData%xMinv,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%xMinv) + IntKiBuf(Int_Xferred) = InData%MAXINFLO + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%xMinv,1), UBOUND(InData%xMinv,1) + ReKiBuf(Re_Xferred) = InData%xMinv(i1) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE AD14_PackDynInflowParms SUBROUTINE AD14_UnPackDynInflowParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -7068,12 +7069,6 @@ SUBROUTINE AD14_UnPackDynInflowParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -7088,19 +7083,14 @@ SUBROUTINE AD14_UnPackDynInflowParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%MAXINFLO = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%MAXINFLO = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%xMinv,1) i1_u = UBOUND(OutData%xMinv,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%xMinv = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%xMinv))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%xMinv) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%xMinv,1), UBOUND(OutData%xMinv,1) + OutData%xMinv(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE AD14_UnPackDynInflowParms SUBROUTINE AD14_CopyElement( SrcElementData, DstElementData, CtrlCode, ErrStat, ErrMsg ) @@ -7341,8 +7331,12 @@ SUBROUTINE AD14_PackElement( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%A,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%A)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%A))-1 ) = PACK(InData%A,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%A) + DO i2 = LBOUND(InData%A,2), UBOUND(InData%A,2) + DO i1 = LBOUND(InData%A,1), UBOUND(InData%A,1) + ReKiBuf(Re_Xferred) = InData%A(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%AP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7357,8 +7351,12 @@ SUBROUTINE AD14_PackElement( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AP,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AP)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AP))-1 ) = PACK(InData%AP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AP) + DO i2 = LBOUND(InData%AP,2), UBOUND(InData%AP,2) + DO i1 = LBOUND(InData%AP,1), UBOUND(InData%AP,1) + ReKiBuf(Re_Xferred) = InData%AP(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%ALPHA) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7373,8 +7371,12 @@ SUBROUTINE AD14_PackElement( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ALPHA,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ALPHA)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%ALPHA))-1 ) = PACK(InData%ALPHA,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%ALPHA) + DO i2 = LBOUND(InData%ALPHA,2), UBOUND(InData%ALPHA,2) + DO i1 = LBOUND(InData%ALPHA,1), UBOUND(InData%ALPHA,1) + ReKiBuf(Re_Xferred) = InData%ALPHA(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%W2) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7389,8 +7391,12 @@ SUBROUTINE AD14_PackElement( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%W2,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%W2)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%W2))-1 ) = PACK(InData%W2,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%W2) + DO i2 = LBOUND(InData%W2,2), UBOUND(InData%W2,2) + DO i1 = LBOUND(InData%W2,1), UBOUND(InData%W2,1) + ReKiBuf(Re_Xferred) = InData%W2(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%OLD_A_NS) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7405,8 +7411,12 @@ SUBROUTINE AD14_PackElement( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLD_A_NS,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%OLD_A_NS)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%OLD_A_NS))-1 ) = PACK(InData%OLD_A_NS,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%OLD_A_NS) + DO i2 = LBOUND(InData%OLD_A_NS,2), UBOUND(InData%OLD_A_NS,2) + DO i1 = LBOUND(InData%OLD_A_NS,1), UBOUND(InData%OLD_A_NS,1) + ReKiBuf(Re_Xferred) = InData%OLD_A_NS(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%OLD_AP_NS) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7421,11 +7431,15 @@ SUBROUTINE AD14_PackElement( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OLD_AP_NS,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%OLD_AP_NS)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%OLD_AP_NS))-1 ) = PACK(InData%OLD_AP_NS,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%OLD_AP_NS) + DO i2 = LBOUND(InData%OLD_AP_NS,2), UBOUND(InData%OLD_AP_NS,2) + DO i1 = LBOUND(InData%OLD_AP_NS,1), UBOUND(InData%OLD_AP_NS,1) + ReKiBuf(Re_Xferred) = InData%OLD_AP_NS(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PITNOW - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PITNOW + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AD14_PackElement SUBROUTINE AD14_UnPackElement( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -7441,12 +7455,6 @@ SUBROUTINE AD14_UnPackElement( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -7478,15 +7486,12 @@ SUBROUTINE AD14_UnPackElement( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%A.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%A)>0) OutData%A = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%A))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%A) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%A,2), UBOUND(OutData%A,2) + DO i1 = LBOUND(OutData%A,1), UBOUND(OutData%A,1) + OutData%A(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AP not allocated Int_Xferred = Int_Xferred + 1 @@ -7504,15 +7509,12 @@ SUBROUTINE AD14_UnPackElement( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%AP)>0) OutData%AP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AP))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AP) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AP,2), UBOUND(OutData%AP,2) + DO i1 = LBOUND(OutData%AP,1), UBOUND(OutData%AP,1) + OutData%AP(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ALPHA not allocated Int_Xferred = Int_Xferred + 1 @@ -7530,15 +7532,12 @@ SUBROUTINE AD14_UnPackElement( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ALPHA.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%ALPHA)>0) OutData%ALPHA = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%ALPHA))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%ALPHA) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%ALPHA,2), UBOUND(OutData%ALPHA,2) + DO i1 = LBOUND(OutData%ALPHA,1), UBOUND(OutData%ALPHA,1) + OutData%ALPHA(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! W2 not allocated Int_Xferred = Int_Xferred + 1 @@ -7556,15 +7555,12 @@ SUBROUTINE AD14_UnPackElement( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%W2.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%W2)>0) OutData%W2 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%W2))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%W2) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%W2,2), UBOUND(OutData%W2,2) + DO i1 = LBOUND(OutData%W2,1), UBOUND(OutData%W2,1) + OutData%W2(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLD_A_NS not allocated Int_Xferred = Int_Xferred + 1 @@ -7582,15 +7578,12 @@ SUBROUTINE AD14_UnPackElement( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLD_A_NS.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%OLD_A_NS)>0) OutData%OLD_A_NS = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%OLD_A_NS))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%OLD_A_NS) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%OLD_A_NS,2), UBOUND(OutData%OLD_A_NS,2) + DO i1 = LBOUND(OutData%OLD_A_NS,1), UBOUND(OutData%OLD_A_NS,1) + OutData%OLD_A_NS(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OLD_AP_NS not allocated Int_Xferred = Int_Xferred + 1 @@ -7608,18 +7601,15 @@ SUBROUTINE AD14_UnPackElement( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OLD_AP_NS.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%OLD_AP_NS)>0) OutData%OLD_AP_NS = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%OLD_AP_NS))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%OLD_AP_NS) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%OLD_AP_NS,2), UBOUND(OutData%OLD_AP_NS,2) + DO i1 = LBOUND(OutData%OLD_AP_NS,1), UBOUND(OutData%OLD_AP_NS,1) + OutData%OLD_AP_NS(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - OutData%PITNOW = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%PITNOW = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AD14_UnPackElement SUBROUTINE AD14_CopyElementParms( SrcElementParmsData, DstElementParmsData, CtrlCode, ErrStat, ErrMsg ) @@ -7794,8 +7784,8 @@ SUBROUTINE AD14_PackElementParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NELM - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NELM + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%TWIST) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -7806,8 +7796,10 @@ SUBROUTINE AD14_PackElementParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TWIST,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TWIST)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TWIST))-1 ) = PACK(InData%TWIST,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TWIST) + DO i1 = LBOUND(InData%TWIST,1), UBOUND(InData%TWIST,1) + ReKiBuf(Re_Xferred) = InData%TWIST(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%RELM) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7819,8 +7811,10 @@ SUBROUTINE AD14_PackElementParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RELM,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RELM)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RELM))-1 ) = PACK(InData%RELM,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RELM) + DO i1 = LBOUND(InData%RELM,1), UBOUND(InData%RELM,1) + ReKiBuf(Re_Xferred) = InData%RELM(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%HLCNST) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7832,8 +7826,10 @@ SUBROUTINE AD14_PackElementParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HLCNST,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%HLCNST)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%HLCNST))-1 ) = PACK(InData%HLCNST,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%HLCNST) + DO i1 = LBOUND(InData%HLCNST,1), UBOUND(InData%HLCNST,1) + ReKiBuf(Re_Xferred) = InData%HLCNST(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TLCNST) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7845,8 +7841,10 @@ SUBROUTINE AD14_PackElementParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TLCNST,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TLCNST)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TLCNST))-1 ) = PACK(InData%TLCNST,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TLCNST) + DO i1 = LBOUND(InData%TLCNST,1), UBOUND(InData%TLCNST,1) + ReKiBuf(Re_Xferred) = InData%TLCNST(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE AD14_PackElementParms @@ -7863,12 +7861,6 @@ SUBROUTINE AD14_UnPackElementParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -7883,8 +7875,8 @@ SUBROUTINE AD14_UnPackElementParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%NELM = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NELM = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TWIST not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -7898,15 +7890,10 @@ SUBROUTINE AD14_UnPackElementParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TWIST.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TWIST)>0) OutData%TWIST = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TWIST))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TWIST) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TWIST,1), UBOUND(OutData%TWIST,1) + OutData%TWIST(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RELM not allocated Int_Xferred = Int_Xferred + 1 @@ -7921,15 +7908,10 @@ SUBROUTINE AD14_UnPackElementParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RELM.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%RELM)>0) OutData%RELM = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RELM))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RELM) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%RELM,1), UBOUND(OutData%RELM,1) + OutData%RELM(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! HLCNST not allocated Int_Xferred = Int_Xferred + 1 @@ -7944,15 +7926,10 @@ SUBROUTINE AD14_UnPackElementParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%HLCNST.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%HLCNST)>0) OutData%HLCNST = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%HLCNST))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%HLCNST) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%HLCNST,1), UBOUND(OutData%HLCNST,1) + OutData%HLCNST(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TLCNST not allocated Int_Xferred = Int_Xferred + 1 @@ -7967,15 +7944,10 @@ SUBROUTINE AD14_UnPackElementParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TLCNST.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TLCNST)>0) OutData%TLCNST = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TLCNST))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TLCNST) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TLCNST,1), UBOUND(OutData%TLCNST,1) + OutData%TLCNST(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE AD14_UnPackElementParms @@ -8516,8 +8488,10 @@ SUBROUTINE AD14_PackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AAA,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AAA)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AAA))-1 ) = PACK(InData%AAA,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AAA) + DO i1 = LBOUND(InData%AAA,1), UBOUND(InData%AAA,1) + ReKiBuf(Re_Xferred) = InData%AAA(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%AAP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8529,8 +8503,10 @@ SUBROUTINE AD14_PackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AAP,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AAP)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AAP))-1 ) = PACK(InData%AAP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AAP) + DO i1 = LBOUND(InData%AAP,1), UBOUND(InData%AAP,1) + ReKiBuf(Re_Xferred) = InData%AAP(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%ALF) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8542,8 +8518,10 @@ SUBROUTINE AD14_PackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ALF,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ALF)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%ALF))-1 ) = PACK(InData%ALF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%ALF) + DO i1 = LBOUND(InData%ALF,1), UBOUND(InData%ALF,1) + ReKiBuf(Re_Xferred) = InData%ALF(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%CDD) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8555,8 +8533,10 @@ SUBROUTINE AD14_PackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CDD,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CDD)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CDD))-1 ) = PACK(InData%CDD,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CDD) + DO i1 = LBOUND(InData%CDD,1), UBOUND(InData%CDD,1) + ReKiBuf(Re_Xferred) = InData%CDD(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%CLL) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8568,8 +8548,10 @@ SUBROUTINE AD14_PackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CLL,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CLL)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CLL))-1 ) = PACK(InData%CLL,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CLL) + DO i1 = LBOUND(InData%CLL,1), UBOUND(InData%CLL,1) + ReKiBuf(Re_Xferred) = InData%CLL(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%CMM) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8581,8 +8563,10 @@ SUBROUTINE AD14_PackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CMM,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CMM)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CMM))-1 ) = PACK(InData%CMM,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CMM) + DO i1 = LBOUND(InData%CMM,1), UBOUND(InData%CMM,1) + ReKiBuf(Re_Xferred) = InData%CMM(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%CNN) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8594,8 +8578,10 @@ SUBROUTINE AD14_PackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CNN,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CNN)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CNN))-1 ) = PACK(InData%CNN,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CNN) + DO i1 = LBOUND(InData%CNN,1), UBOUND(InData%CNN,1) + ReKiBuf(Re_Xferred) = InData%CNN(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%CTT) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8607,8 +8593,10 @@ SUBROUTINE AD14_PackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CTT,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CTT)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CTT))-1 ) = PACK(InData%CTT,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CTT) + DO i1 = LBOUND(InData%CTT,1), UBOUND(InData%CTT,1) + ReKiBuf(Re_Xferred) = InData%CTT(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%DFNSAV) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8620,8 +8608,10 @@ SUBROUTINE AD14_PackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DFNSAV,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DFNSAV)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%DFNSAV))-1 ) = PACK(InData%DFNSAV,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%DFNSAV) + DO i1 = LBOUND(InData%DFNSAV,1), UBOUND(InData%DFNSAV,1) + ReKiBuf(Re_Xferred) = InData%DFNSAV(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%DFTSAV) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8633,8 +8623,10 @@ SUBROUTINE AD14_PackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DFTSAV,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DFTSAV)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%DFTSAV))-1 ) = PACK(InData%DFTSAV,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%DFTSAV) + DO i1 = LBOUND(InData%DFTSAV,1), UBOUND(InData%DFTSAV,1) + ReKiBuf(Re_Xferred) = InData%DFTSAV(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%DynPres) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8646,8 +8638,10 @@ SUBROUTINE AD14_PackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DynPres,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DynPres)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%DynPres))-1 ) = PACK(InData%DynPres,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%DynPres) + DO i1 = LBOUND(InData%DynPres,1), UBOUND(InData%DynPres,1) + ReKiBuf(Re_Xferred) = InData%DynPres(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%PMM) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8659,8 +8653,10 @@ SUBROUTINE AD14_PackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMM,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PMM)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PMM))-1 ) = PACK(InData%PMM,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PMM) + DO i1 = LBOUND(InData%PMM,1), UBOUND(InData%PMM,1) + ReKiBuf(Re_Xferred) = InData%PMM(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%PITSAV) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8672,8 +8668,10 @@ SUBROUTINE AD14_PackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PITSAV,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PITSAV)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PITSAV))-1 ) = PACK(InData%PITSAV,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PITSAV) + DO i1 = LBOUND(InData%PITSAV,1), UBOUND(InData%PITSAV,1) + ReKiBuf(Re_Xferred) = InData%PITSAV(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%ReyNum) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8685,8 +8683,10 @@ SUBROUTINE AD14_PackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ReyNum,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ReyNum)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%ReyNum))-1 ) = PACK(InData%ReyNum,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%ReyNum) + DO i1 = LBOUND(InData%ReyNum,1), UBOUND(InData%ReyNum,1) + ReKiBuf(Re_Xferred) = InData%ReyNum(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%SaveVX) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8701,8 +8701,12 @@ SUBROUTINE AD14_PackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SaveVX,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%SaveVX)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SaveVX))-1 ) = PACK(InData%SaveVX,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SaveVX) + DO i2 = LBOUND(InData%SaveVX,2), UBOUND(InData%SaveVX,2) + DO i1 = LBOUND(InData%SaveVX,1), UBOUND(InData%SaveVX,1) + ReKiBuf(Re_Xferred) = InData%SaveVX(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%SaveVY) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8717,8 +8721,12 @@ SUBROUTINE AD14_PackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SaveVY,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%SaveVY)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SaveVY))-1 ) = PACK(InData%SaveVY,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SaveVY) + DO i2 = LBOUND(InData%SaveVY,2), UBOUND(InData%SaveVY,2) + DO i1 = LBOUND(InData%SaveVY,1), UBOUND(InData%SaveVY,1) + ReKiBuf(Re_Xferred) = InData%SaveVY(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%SaveVZ) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8733,17 +8741,21 @@ SUBROUTINE AD14_PackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SaveVZ,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%SaveVZ)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SaveVZ))-1 ) = PACK(InData%SaveVZ,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SaveVZ) + DO i2 = LBOUND(InData%SaveVZ,2), UBOUND(InData%SaveVZ,2) + DO i1 = LBOUND(InData%SaveVZ,1), UBOUND(InData%SaveVZ,1) + ReKiBuf(Re_Xferred) = InData%SaveVZ(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%VXSAV - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%VYSAV - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%VZSAV - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumWndElOut - Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VXSAV + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VYSAV + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VZSAV + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumWndElOut + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WndElPrList) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -8754,8 +8766,10 @@ SUBROUTINE AD14_PackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WndElPrList,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WndElPrList)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%WndElPrList))-1 ) = PACK(InData%WndElPrList,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%WndElPrList) + DO i1 = LBOUND(InData%WndElPrList,1), UBOUND(InData%WndElPrList,1) + IntKiBuf(Int_Xferred) = InData%WndElPrList(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WndElPrNum) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8767,8 +8781,10 @@ SUBROUTINE AD14_PackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WndElPrNum,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WndElPrNum)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%WndElPrNum))-1 ) = PACK(InData%WndElPrNum,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%WndElPrNum) + DO i1 = LBOUND(InData%WndElPrNum,1), UBOUND(InData%WndElPrNum,1) + IntKiBuf(Int_Xferred) = InData%WndElPrNum(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%ElPrList) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8780,8 +8796,10 @@ SUBROUTINE AD14_PackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElPrList,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ElPrList)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%ElPrList))-1 ) = PACK(InData%ElPrList,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%ElPrList) + DO i1 = LBOUND(InData%ElPrList,1), UBOUND(InData%ElPrList,1) + IntKiBuf(Int_Xferred) = InData%ElPrList(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%ElPrNum) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8793,11 +8811,13 @@ SUBROUTINE AD14_PackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElPrNum,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ElPrNum)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%ElPrNum))-1 ) = PACK(InData%ElPrNum,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%ElPrNum) + DO i1 = LBOUND(InData%ElPrNum,1), UBOUND(InData%ElPrNum,1) + IntKiBuf(Int_Xferred) = InData%ElPrNum(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumElOut - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumElOut + Int_Xferred = Int_Xferred + 1 END SUBROUTINE AD14_PackElOutParms SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -8813,12 +8833,6 @@ SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -8847,15 +8861,10 @@ SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AAA.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%AAA)>0) OutData%AAA = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AAA))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AAA) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AAA,1), UBOUND(OutData%AAA,1) + OutData%AAA(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AAP not allocated Int_Xferred = Int_Xferred + 1 @@ -8870,15 +8879,10 @@ SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AAP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%AAP)>0) OutData%AAP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AAP))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AAP) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AAP,1), UBOUND(OutData%AAP,1) + OutData%AAP(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ALF not allocated Int_Xferred = Int_Xferred + 1 @@ -8888,20 +8892,15 @@ SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 IF (ALLOCATED(OutData%ALF)) DEALLOCATE(OutData%ALF) - ALLOCATE(OutData%ALF(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ALF.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) + ALLOCATE(OutData%ALF(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ALF.', ErrStat, ErrMsg,RoutineName) RETURN END IF - mask1 = .TRUE. - IF (SIZE(OutData%ALF)>0) OutData%ALF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%ALF))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%ALF) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%ALF,1), UBOUND(OutData%ALF,1) + OutData%ALF(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CDD not allocated Int_Xferred = Int_Xferred + 1 @@ -8916,15 +8915,10 @@ SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CDD.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%CDD)>0) OutData%CDD = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CDD))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CDD) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%CDD,1), UBOUND(OutData%CDD,1) + OutData%CDD(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CLL not allocated Int_Xferred = Int_Xferred + 1 @@ -8939,15 +8933,10 @@ SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CLL.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%CLL)>0) OutData%CLL = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CLL))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CLL) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%CLL,1), UBOUND(OutData%CLL,1) + OutData%CLL(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CMM not allocated Int_Xferred = Int_Xferred + 1 @@ -8962,15 +8951,10 @@ SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CMM.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%CMM)>0) OutData%CMM = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CMM))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CMM) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%CMM,1), UBOUND(OutData%CMM,1) + OutData%CMM(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CNN not allocated Int_Xferred = Int_Xferred + 1 @@ -8985,15 +8969,10 @@ SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CNN.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%CNN)>0) OutData%CNN = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CNN))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CNN) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%CNN,1), UBOUND(OutData%CNN,1) + OutData%CNN(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CTT not allocated Int_Xferred = Int_Xferred + 1 @@ -9008,15 +8987,10 @@ SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CTT.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%CTT)>0) OutData%CTT = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CTT))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CTT) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%CTT,1), UBOUND(OutData%CTT,1) + OutData%CTT(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DFNSAV not allocated Int_Xferred = Int_Xferred + 1 @@ -9031,15 +9005,10 @@ SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DFNSAV.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%DFNSAV)>0) OutData%DFNSAV = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%DFNSAV))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%DFNSAV) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%DFNSAV,1), UBOUND(OutData%DFNSAV,1) + OutData%DFNSAV(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DFTSAV not allocated Int_Xferred = Int_Xferred + 1 @@ -9054,15 +9023,10 @@ SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DFTSAV.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%DFTSAV)>0) OutData%DFTSAV = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%DFTSAV))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%DFTSAV) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%DFTSAV,1), UBOUND(OutData%DFTSAV,1) + OutData%DFTSAV(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DynPres not allocated Int_Xferred = Int_Xferred + 1 @@ -9077,15 +9041,10 @@ SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DynPres.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%DynPres)>0) OutData%DynPres = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%DynPres))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%DynPres) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%DynPres,1), UBOUND(OutData%DynPres,1) + OutData%DynPres(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PMM not allocated Int_Xferred = Int_Xferred + 1 @@ -9100,15 +9059,10 @@ SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMM.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%PMM)>0) OutData%PMM = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PMM))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PMM) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%PMM,1), UBOUND(OutData%PMM,1) + OutData%PMM(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PITSAV not allocated Int_Xferred = Int_Xferred + 1 @@ -9123,15 +9077,10 @@ SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PITSAV.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%PITSAV)>0) OutData%PITSAV = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PITSAV))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PITSAV) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%PITSAV,1), UBOUND(OutData%PITSAV,1) + OutData%PITSAV(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ReyNum not allocated Int_Xferred = Int_Xferred + 1 @@ -9146,15 +9095,10 @@ SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ReyNum.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%ReyNum)>0) OutData%ReyNum = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%ReyNum))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%ReyNum) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%ReyNum,1), UBOUND(OutData%ReyNum,1) + OutData%ReyNum(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SaveVX not allocated Int_Xferred = Int_Xferred + 1 @@ -9172,15 +9116,12 @@ SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SaveVX.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%SaveVX)>0) OutData%SaveVX = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SaveVX))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SaveVX) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%SaveVX,2), UBOUND(OutData%SaveVX,2) + DO i1 = LBOUND(OutData%SaveVX,1), UBOUND(OutData%SaveVX,1) + OutData%SaveVX(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SaveVY not allocated Int_Xferred = Int_Xferred + 1 @@ -9198,15 +9139,12 @@ SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SaveVY.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%SaveVY)>0) OutData%SaveVY = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SaveVY))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SaveVY) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%SaveVY,2), UBOUND(OutData%SaveVY,2) + DO i1 = LBOUND(OutData%SaveVY,1), UBOUND(OutData%SaveVY,1) + OutData%SaveVY(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SaveVZ not allocated Int_Xferred = Int_Xferred + 1 @@ -9224,24 +9162,21 @@ SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SaveVZ.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%SaveVZ)>0) OutData%SaveVZ = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SaveVZ))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SaveVZ) - DEALLOCATE(mask2) - END IF - OutData%VXSAV = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%VYSAV = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%VZSAV = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NumWndElOut = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(OutData%SaveVZ,2), UBOUND(OutData%SaveVZ,2) + DO i1 = LBOUND(OutData%SaveVZ,1), UBOUND(OutData%SaveVZ,1) + OutData%SaveVZ(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%VXSAV = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%VYSAV = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%VZSAV = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NumWndElOut = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WndElPrList not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -9255,15 +9190,10 @@ SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WndElPrList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WndElPrList)>0) OutData%WndElPrList = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%WndElPrList))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%WndElPrList) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WndElPrList,1), UBOUND(OutData%WndElPrList,1) + OutData%WndElPrList(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WndElPrNum not allocated Int_Xferred = Int_Xferred + 1 @@ -9278,15 +9208,10 @@ SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WndElPrNum.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WndElPrNum)>0) OutData%WndElPrNum = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%WndElPrNum))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%WndElPrNum) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WndElPrNum,1), UBOUND(OutData%WndElPrNum,1) + OutData%WndElPrNum(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ElPrList not allocated Int_Xferred = Int_Xferred + 1 @@ -9301,15 +9226,10 @@ SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElPrList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%ElPrList)>0) OutData%ElPrList = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%ElPrList))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%ElPrList) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%ElPrList,1), UBOUND(OutData%ElPrList,1) + OutData%ElPrList(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ElPrNum not allocated Int_Xferred = Int_Xferred + 1 @@ -9324,18 +9244,13 @@ SUBROUTINE AD14_UnPackElOutParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElPrNum.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%ElPrNum)>0) OutData%ElPrNum = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%ElPrNum))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%ElPrNum) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%ElPrNum,1), UBOUND(OutData%ElPrNum,1) + OutData%ElPrNum(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF - OutData%NumElOut = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NumElOut = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE AD14_UnPackElOutParms SUBROUTINE AD14_CopyInducedVel( SrcInducedVelData, DstInducedVelData, CtrlCode, ErrStat, ErrMsg ) @@ -9429,8 +9344,8 @@ SUBROUTINE AD14_PackInducedVel( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SumInFl - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SumInFl + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AD14_PackInducedVel SUBROUTINE AD14_UnPackInducedVel( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -9446,12 +9361,6 @@ SUBROUTINE AD14_UnPackInducedVel( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackInducedVel' @@ -9465,8 +9374,8 @@ SUBROUTINE AD14_UnPackInducedVel( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%SumInFl = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%SumInFl = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AD14_UnPackInducedVel SUBROUTINE AD14_CopyInducedVelParms( SrcInducedVelParmsData, DstInducedVelParmsData, CtrlCode, ErrStat, ErrMsg ) @@ -9572,20 +9481,20 @@ SUBROUTINE AD14_PackInducedVelParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AToler - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%EqAIDmult - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%EquilDA , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%EquilDT , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TLoss , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%GTech , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%HLoss , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AToler + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%EqAIDmult + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%EquilDA, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%EquilDT, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TLoss, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%GTech, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%HLoss, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE AD14_PackInducedVelParms SUBROUTINE AD14_UnPackInducedVelParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -9601,12 +9510,6 @@ SUBROUTINE AD14_UnPackInducedVelParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackInducedVelParms' @@ -9620,20 +9523,20 @@ SUBROUTINE AD14_UnPackInducedVelParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%AToler = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%EqAIDmult = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%EquilDA = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%EquilDT = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%TLoss = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%GTech = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%HLoss = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%AToler = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%EqAIDmult = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%EquilDA = TRANSFER(IntKiBuf(Int_Xferred), OutData%EquilDA) + Int_Xferred = Int_Xferred + 1 + OutData%EquilDT = TRANSFER(IntKiBuf(Int_Xferred), OutData%EquilDT) + Int_Xferred = Int_Xferred + 1 + OutData%TLoss = TRANSFER(IntKiBuf(Int_Xferred), OutData%TLoss) + Int_Xferred = Int_Xferred + 1 + OutData%GTech = TRANSFER(IntKiBuf(Int_Xferred), OutData%GTech) + Int_Xferred = Int_Xferred + 1 + OutData%HLoss = TRANSFER(IntKiBuf(Int_Xferred), OutData%HLoss) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE AD14_UnPackInducedVelParms SUBROUTINE AD14_CopyRotor( SrcRotorData, DstRotorData, CtrlCode, ErrStat, ErrMsg ) @@ -9743,24 +9646,24 @@ SUBROUTINE AD14_PackRotor( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AVGINFL - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CTILT - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CYaw - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%REVS - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%STILT - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SYaw - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TILT - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawAng - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawVEL - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AVGINFL + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CTILT + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CYaw + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%REVS + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%STILT + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SYaw + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TILT + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawAng + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawVEL + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AD14_PackRotor SUBROUTINE AD14_UnPackRotor( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -9776,12 +9679,6 @@ SUBROUTINE AD14_UnPackRotor( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackRotor' @@ -9795,24 +9692,24 @@ SUBROUTINE AD14_UnPackRotor( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%AVGINFL = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%CTILT = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%CYaw = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%REVS = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%STILT = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SYaw = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TILT = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawAng = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawVEL = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%AVGINFL = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%CTILT = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%CYaw = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%REVS = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%STILT = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SYaw = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TILT = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawAng = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawVEL = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AD14_UnPackRotor SUBROUTINE AD14_CopyRotorParms( SrcRotorParmsData, DstRotorParmsData, CtrlCode, ErrStat, ErrMsg ) @@ -9906,8 +9803,8 @@ SUBROUTINE AD14_PackRotorParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HH - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HH + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AD14_PackRotorParms SUBROUTINE AD14_UnPackRotorParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -9923,12 +9820,6 @@ SUBROUTINE AD14_UnPackRotorParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackRotorParms' @@ -9942,8 +9833,8 @@ SUBROUTINE AD14_UnPackRotorParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%HH = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%HH = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AD14_UnPackRotorParms SUBROUTINE AD14_CopyTwrPropsParms( SrcTwrPropsParmsData, DstTwrPropsParmsData, CtrlCode, ErrStat, ErrMsg ) @@ -10201,8 +10092,10 @@ SUBROUTINE AD14_PackTwrPropsParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrHtFr,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwrHtFr)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwrHtFr))-1 ) = PACK(InData%TwrHtFr,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwrHtFr) + DO i1 = LBOUND(InData%TwrHtFr,1), UBOUND(InData%TwrHtFr,1) + ReKiBuf(Re_Xferred) = InData%TwrHtFr(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TwrWid) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10214,8 +10107,10 @@ SUBROUTINE AD14_PackTwrPropsParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrWid,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwrWid)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwrWid))-1 ) = PACK(InData%TwrWid,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwrWid) + DO i1 = LBOUND(InData%TwrWid,1), UBOUND(InData%TwrWid,1) + ReKiBuf(Re_Xferred) = InData%TwrWid(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TwrCD) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10230,8 +10125,12 @@ SUBROUTINE AD14_PackTwrPropsParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrCD,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwrCD)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwrCD))-1 ) = PACK(InData%TwrCD,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwrCD) + DO i2 = LBOUND(InData%TwrCD,2), UBOUND(InData%TwrCD,2) + DO i1 = LBOUND(InData%TwrCD,1), UBOUND(InData%TwrCD,1) + ReKiBuf(Re_Xferred) = InData%TwrCD(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%TwrRe) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10243,13 +10142,17 @@ SUBROUTINE AD14_PackTwrPropsParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrRe,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwrRe)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwrRe))-1 ) = PACK(InData%TwrRe,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwrRe) + DO i1 = LBOUND(InData%TwrRe,1), UBOUND(InData%TwrRe,1) + ReKiBuf(Re_Xferred) = InData%TwrRe(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%VTwr))-1 ) = PACK(InData%VTwr,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%VTwr) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Tower_Wake_Constant - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%VTwr,1), UBOUND(InData%VTwr,1) + ReKiBuf(Re_Xferred) = InData%VTwr(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%Tower_Wake_Constant + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%NTwrCDCol) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -10260,39 +10163,41 @@ SUBROUTINE AD14_PackTwrPropsParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NTwrCDCol,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%NTwrCDCol)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%NTwrCDCol))-1 ) = PACK(InData%NTwrCDCol,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%NTwrCDCol) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NTwrHT - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NTwrRe - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NTwrCD - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TwrPotent , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TwrShadow , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ShadHWid - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TShadC1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TShadC2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TwrShad - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PJM_Version , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%TwrFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%TwrFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%T_Shad_Refpt - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%CalcTwrAero , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumTwrNodes - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%NTwrCDCol,1), UBOUND(InData%NTwrCDCol,1) + IntKiBuf(Int_Xferred) = InData%NTwrCDCol(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IntKiBuf(Int_Xferred) = InData%NTwrHT + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NTwrRe + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NTwrCD + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TwrPotent, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TwrShadow, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%ShadHWid + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TShadC1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TShadC2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TwrShad + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%PJM_Version, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%TwrFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%TwrFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + ReKiBuf(Re_Xferred) = InData%T_Shad_Refpt + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%CalcTwrAero, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumTwrNodes + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%TwrNodeWidth) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -10303,8 +10208,10 @@ SUBROUTINE AD14_PackTwrPropsParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrNodeWidth,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwrNodeWidth)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwrNodeWidth))-1 ) = PACK(InData%TwrNodeWidth,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwrNodeWidth) + DO i1 = LBOUND(InData%TwrNodeWidth,1), UBOUND(InData%TwrNodeWidth,1) + ReKiBuf(Re_Xferred) = InData%TwrNodeWidth(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE AD14_PackTwrPropsParms @@ -10321,12 +10228,6 @@ SUBROUTINE AD14_UnPackTwrPropsParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -10355,15 +10256,10 @@ SUBROUTINE AD14_UnPackTwrPropsParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrHtFr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwrHtFr)>0) OutData%TwrHtFr = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwrHtFr))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwrHtFr) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwrHtFr,1), UBOUND(OutData%TwrHtFr,1) + OutData%TwrHtFr(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrWid not allocated Int_Xferred = Int_Xferred + 1 @@ -10378,15 +10274,10 @@ SUBROUTINE AD14_UnPackTwrPropsParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrWid.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwrWid)>0) OutData%TwrWid = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwrWid))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwrWid) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwrWid,1), UBOUND(OutData%TwrWid,1) + OutData%TwrWid(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrCD not allocated Int_Xferred = Int_Xferred + 1 @@ -10404,15 +10295,12 @@ SUBROUTINE AD14_UnPackTwrPropsParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrCD.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%TwrCD)>0) OutData%TwrCD = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwrCD))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwrCD) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%TwrCD,2), UBOUND(OutData%TwrCD,2) + DO i1 = LBOUND(OutData%TwrCD,1), UBOUND(OutData%TwrCD,1) + OutData%TwrCD(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrRe not allocated Int_Xferred = Int_Xferred + 1 @@ -10427,29 +10315,19 @@ SUBROUTINE AD14_UnPackTwrPropsParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrRe.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwrRe)>0) OutData%TwrRe = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwrRe))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwrRe) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwrRe,1), UBOUND(OutData%TwrRe,1) + OutData%TwrRe(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF i1_l = LBOUND(OutData%VTwr,1) i1_u = UBOUND(OutData%VTwr,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%VTwr = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%VTwr))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%VTwr) - DEALLOCATE(mask1) - OutData%Tower_Wake_Constant = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%VTwr,1), UBOUND(OutData%VTwr,1) + OutData%VTwr(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%Tower_Wake_Constant = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NTwrCDCol not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -10463,46 +10341,41 @@ SUBROUTINE AD14_UnPackTwrPropsParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NTwrCDCol.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%NTwrCDCol)>0) OutData%NTwrCDCol = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%NTwrCDCol))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%NTwrCDCol) - DEALLOCATE(mask1) - END IF - OutData%NTwrHT = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NTwrRe = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NTwrCD = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TwrPotent = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%TwrShadow = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%ShadHWid = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TShadC1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TShadC2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TwrShad = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PJM_Version = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%TwrFile) - OutData%TwrFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%T_Shad_Refpt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%CalcTwrAero = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NumTwrNodes = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%NTwrCDCol,1), UBOUND(OutData%NTwrCDCol,1) + OutData%NTwrCDCol(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + OutData%NTwrHT = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NTwrRe = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NTwrCD = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TwrPotent = TRANSFER(IntKiBuf(Int_Xferred), OutData%TwrPotent) + Int_Xferred = Int_Xferred + 1 + OutData%TwrShadow = TRANSFER(IntKiBuf(Int_Xferred), OutData%TwrShadow) + Int_Xferred = Int_Xferred + 1 + OutData%ShadHWid = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TShadC1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TShadC2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TwrShad = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PJM_Version = TRANSFER(IntKiBuf(Int_Xferred), OutData%PJM_Version) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%TwrFile) + OutData%TwrFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%T_Shad_Refpt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%CalcTwrAero = TRANSFER(IntKiBuf(Int_Xferred), OutData%CalcTwrAero) + Int_Xferred = Int_Xferred + 1 + OutData%NumTwrNodes = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrNodeWidth not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -10516,15 +10389,10 @@ SUBROUTINE AD14_UnPackTwrPropsParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrNodeWidth.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwrNodeWidth)>0) OutData%TwrNodeWidth = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwrNodeWidth))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwrNodeWidth) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwrNodeWidth,1), UBOUND(OutData%TwrNodeWidth,1) + OutData%TwrNodeWidth(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE AD14_UnPackTwrPropsParms @@ -10629,18 +10497,18 @@ SUBROUTINE AD14_PackWind( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ANGFLW - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CDEL - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%VROTORX - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%VROTORY - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%VROTORZ - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SDEL - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%ANGFLW + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CDEL + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VROTORX + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VROTORY + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VROTORZ + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SDEL + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AD14_PackWind SUBROUTINE AD14_UnPackWind( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -10656,12 +10524,6 @@ SUBROUTINE AD14_UnPackWind( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackWind' @@ -10675,18 +10537,18 @@ SUBROUTINE AD14_UnPackWind( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%ANGFLW = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%CDEL = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%VROTORX = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%VROTORY = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%VROTORZ = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SDEL = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%ANGFLW = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%CDEL = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%VROTORX = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%VROTORY = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%VROTORZ = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SDEL = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AD14_UnPackWind SUBROUTINE AD14_CopyWindParms( SrcWindParmsData, DstWindParmsData, CtrlCode, ErrStat, ErrMsg ) @@ -10782,10 +10644,10 @@ SUBROUTINE AD14_PackWindParms( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Rho - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%KinVisc - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Rho + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%KinVisc + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AD14_PackWindParms SUBROUTINE AD14_UnPackWindParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -10801,12 +10663,6 @@ SUBROUTINE AD14_UnPackWindParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackWindParms' @@ -10820,10 +10676,10 @@ SUBROUTINE AD14_UnPackWindParms( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%Rho = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%KinVisc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%Rho = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%KinVisc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AD14_UnPackWindParms SUBROUTINE AD14_CopyPositionType( SrcPositionTypeData, DstPositionTypeData, CtrlCode, ErrStat, ErrMsg ) @@ -10918,8 +10774,10 @@ SUBROUTINE AD14_PackPositionType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Pos))-1 ) = PACK(InData%Pos,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Pos) + DO i1 = LBOUND(InData%Pos,1), UBOUND(InData%Pos,1) + ReKiBuf(Re_Xferred) = InData%Pos(i1) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE AD14_PackPositionType SUBROUTINE AD14_UnPackPositionType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -10935,12 +10793,6 @@ SUBROUTINE AD14_UnPackPositionType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -10957,15 +10809,10 @@ SUBROUTINE AD14_UnPackPositionType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Xferred = 1 i1_l = LBOUND(OutData%Pos,1) i1_u = UBOUND(OutData%Pos,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%Pos = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Pos))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Pos) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Pos,1), UBOUND(OutData%Pos,1) + OutData%Pos(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE AD14_UnPackPositionType SUBROUTINE AD14_CopyOrientationType( SrcOrientationTypeData, DstOrientationTypeData, CtrlCode, ErrStat, ErrMsg ) @@ -11061,8 +10908,12 @@ SUBROUTINE AD14_PackOrientationType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Orient))-1 ) = PACK(InData%Orient,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Orient) + DO i2 = LBOUND(InData%Orient,2), UBOUND(InData%Orient,2) + DO i1 = LBOUND(InData%Orient,1), UBOUND(InData%Orient,1) + ReKiBuf(Re_Xferred) = InData%Orient(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END SUBROUTINE AD14_PackOrientationType SUBROUTINE AD14_UnPackOrientationType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -11078,12 +10929,6 @@ SUBROUTINE AD14_UnPackOrientationType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -11103,15 +10948,12 @@ SUBROUTINE AD14_UnPackOrientationType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS i1_u = UBOUND(OutData%Orient,1) i2_l = LBOUND(OutData%Orient,2) i2_u = UBOUND(OutData%Orient,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%Orient = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Orient))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Orient) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Orient,2), UBOUND(OutData%Orient,2) + DO i1 = LBOUND(OutData%Orient,1), UBOUND(OutData%Orient,1) + OutData%Orient(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END SUBROUTINE AD14_UnPackOrientationType SUBROUTINE AD14_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) @@ -11290,28 +11132,28 @@ SUBROUTINE AD14_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%Title) - IntKiBuf(Int_Xferred) = ICHAR(InData%Title(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%OutRootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutRootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%ADFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%ADFileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%WrSumFile , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumBl - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%BladeLength - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%LinearizeFlag , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%UseDWM , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%Title) + IntKiBuf(Int_Xferred) = ICHAR(InData%Title(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%OutRootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutRootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%ADFileName) + IntKiBuf(Int_Xferred) = ICHAR(InData%ADFileName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%WrSumFile, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumBl + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%BladeLength + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%LinearizeFlag, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%UseDWM, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 CALL AD14_Packaeroconfig( Re_Buf, Db_Buf, Int_Buf, InData%TurbineComponents, ErrStat2, ErrMsg2, OnlySize ) ! TurbineComponents CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -11340,8 +11182,8 @@ SUBROUTINE AD14_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumTwrNodes - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumTwrNodes + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%TwrNodeLocs) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -11355,11 +11197,15 @@ SUBROUTINE AD14_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrNodeLocs,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwrNodeLocs)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwrNodeLocs))-1 ) = PACK(InData%TwrNodeLocs,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwrNodeLocs) + DO i2 = LBOUND(InData%TwrNodeLocs,2), UBOUND(InData%TwrNodeLocs,2) + DO i1 = LBOUND(InData%TwrNodeLocs,1), UBOUND(InData%TwrNodeLocs,1) + ReKiBuf(Re_Xferred) = InData%TwrNodeLocs(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HubHt - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HubHt + Re_Xferred = Re_Xferred + 1 CALL DWM_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%DWM, ErrStat2, ErrMsg2, OnlySize ) ! DWM CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -11403,12 +11249,6 @@ SUBROUTINE AD14_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -11424,28 +11264,28 @@ SUBROUTINE AD14_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%Title) - OutData%Title(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%OutRootName) - OutData%OutRootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%ADFileName) - OutData%ADFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%WrSumFile = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NumBl = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%BladeLength = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%LinearizeFlag = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%UseDWM = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%Title) + OutData%Title(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%OutRootName) + OutData%OutRootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%ADFileName) + OutData%ADFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%WrSumFile = TRANSFER(IntKiBuf(Int_Xferred), OutData%WrSumFile) + Int_Xferred = Int_Xferred + 1 + OutData%NumBl = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%BladeLength = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LinearizeFlag = TRANSFER(IntKiBuf(Int_Xferred), OutData%LinearizeFlag) + Int_Xferred = Int_Xferred + 1 + OutData%UseDWM = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseDWM) + Int_Xferred = Int_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -11486,8 +11326,8 @@ SUBROUTINE AD14_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%NumTwrNodes = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NumTwrNodes = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrNodeLocs not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -11504,18 +11344,15 @@ SUBROUTINE AD14_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrNodeLocs.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%TwrNodeLocs)>0) OutData%TwrNodeLocs = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwrNodeLocs))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwrNodeLocs) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%TwrNodeLocs,2), UBOUND(OutData%TwrNodeLocs,2) + DO i1 = LBOUND(OutData%TwrNodeLocs,1), UBOUND(OutData%TwrNodeLocs,1) + OutData%TwrNodeLocs(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - OutData%HubHt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%HubHt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -11748,8 +11585,8 @@ SUBROUTINE AD14_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AirDens - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AirDens + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AD14_PackInitOutput SUBROUTINE AD14_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -11765,12 +11602,6 @@ SUBROUTINE AD14_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackInitOutput' @@ -11864,8 +11695,8 @@ SUBROUTINE AD14_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%AirDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%AirDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE AD14_UnPackInitOutput SUBROUTINE AD14_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) @@ -12022,12 +11853,6 @@ SUBROUTINE AD14_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackContState' @@ -12237,12 +12062,6 @@ SUBROUTINE AD14_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackDiscState' @@ -12452,12 +12271,6 @@ SUBROUTINE AD14_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackConstrState' @@ -12667,12 +12480,6 @@ SUBROUTINE AD14_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackOtherState' @@ -13236,8 +13043,8 @@ SUBROUTINE AD14_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 IF ( .NOT. ALLOCATED(InData%ElPrNum) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -13248,33 +13055,35 @@ SUBROUTINE AD14_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElPrNum,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ElPrNum)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%ElPrNum))-1 ) = PACK(InData%ElPrNum,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%ElPrNum) - END IF - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%OldTime - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HubLoss - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Loss - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TipLoss - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TLpt7 - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%FirstPassGTL , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%SuperSonic , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%AFLAGVinderr , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%AFLAGTwrInflu , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%OnePassDynDbg , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%NoLoadsCalculated , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NERRORS - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%ElPrNum,1), UBOUND(InData%ElPrNum,1) + IntKiBuf(Int_Xferred) = InData%ElPrNum(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + DbKiBuf(Db_Xferred) = InData%OldTime + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HubLoss + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Loss + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TipLoss + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TLpt7 + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%FirstPassGTL, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%SuperSonic, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%AFLAGVinderr, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%AFLAGTwrInflu, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%OnePassDynDbg, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%NoLoadsCalculated, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NERRORS + Int_Xferred = Int_Xferred + 1 CALL AD14_Packairfoil( Re_Buf, Db_Buf, Int_Buf, InData%AirFoil, ErrStat2, ErrMsg2, OnlySize ) ! AirFoil CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -13499,12 +13308,12 @@ SUBROUTINE AD14_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Skew , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%DynInit , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%FirstWarn , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%Skew, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%DynInit, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%FirstWarn, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%StoredForces) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -13521,8 +13330,14 @@ SUBROUTINE AD14_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StoredForces,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%StoredForces)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%StoredForces))-1 ) = PACK(InData%StoredForces,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%StoredForces) + DO i3 = LBOUND(InData%StoredForces,3), UBOUND(InData%StoredForces,3) + DO i2 = LBOUND(InData%StoredForces,2), UBOUND(InData%StoredForces,2) + DO i1 = LBOUND(InData%StoredForces,1), UBOUND(InData%StoredForces,1) + ReKiBuf(Re_Xferred) = InData%StoredForces(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%StoredMoments) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -13540,8 +13355,14 @@ SUBROUTINE AD14_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StoredMoments,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%StoredMoments)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%StoredMoments))-1 ) = PACK(InData%StoredMoments,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%StoredMoments) + DO i3 = LBOUND(InData%StoredMoments,3), UBOUND(InData%StoredMoments,3) + DO i2 = LBOUND(InData%StoredMoments,2), UBOUND(InData%StoredMoments,2) + DO i1 = LBOUND(InData%StoredMoments,1), UBOUND(InData%StoredMoments,1) + ReKiBuf(Re_Xferred) = InData%StoredMoments(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF END SUBROUTINE AD14_PackMisc @@ -13558,12 +13379,6 @@ SUBROUTINE AD14_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (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 @@ -13700,8 +13515,8 @@ SUBROUTINE AD14_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ElPrNum not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -13715,40 +13530,35 @@ SUBROUTINE AD14_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElPrNum.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%ElPrNum)>0) OutData%ElPrNum = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%ElPrNum))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%ElPrNum) - DEALLOCATE(mask1) - END IF - OutData%OldTime = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%HubLoss = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Loss = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TipLoss = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TLpt7 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%FirstPassGTL = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%SuperSonic = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%AFLAGVinderr = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%AFLAGTwrInflu = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%OnePassDynDbg = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NoLoadsCalculated = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NERRORS = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%ElPrNum,1), UBOUND(OutData%ElPrNum,1) + OutData%ElPrNum(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + OutData%OldTime = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%HubLoss = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Loss = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TipLoss = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TLpt7 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%FirstPassGTL = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstPassGTL) + Int_Xferred = Int_Xferred + 1 + OutData%SuperSonic = TRANSFER(IntKiBuf(Int_Xferred), OutData%SuperSonic) + Int_Xferred = Int_Xferred + 1 + OutData%AFLAGVinderr = TRANSFER(IntKiBuf(Int_Xferred), OutData%AFLAGVinderr) + Int_Xferred = Int_Xferred + 1 + OutData%AFLAGTwrInflu = TRANSFER(IntKiBuf(Int_Xferred), OutData%AFLAGTwrInflu) + Int_Xferred = Int_Xferred + 1 + OutData%OnePassDynDbg = TRANSFER(IntKiBuf(Int_Xferred), OutData%OnePassDynDbg) + Int_Xferred = Int_Xferred + 1 + OutData%NoLoadsCalculated = TRANSFER(IntKiBuf(Int_Xferred), OutData%NoLoadsCalculated) + Int_Xferred = Int_Xferred + 1 + OutData%NERRORS = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -14069,12 +13879,12 @@ SUBROUTINE AD14_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%Skew = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%DynInit = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%FirstWarn = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%Skew = TRANSFER(IntKiBuf(Int_Xferred), OutData%Skew) + Int_Xferred = Int_Xferred + 1 + OutData%DynInit = TRANSFER(IntKiBuf(Int_Xferred), OutData%DynInit) + Int_Xferred = Int_Xferred + 1 + OutData%FirstWarn = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstWarn) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StoredForces not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -14094,15 +13904,14 @@ SUBROUTINE AD14_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StoredForces.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%StoredForces)>0) OutData%StoredForces = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%StoredForces))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%StoredForces) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%StoredForces,3), UBOUND(OutData%StoredForces,3) + DO i2 = LBOUND(OutData%StoredForces,2), UBOUND(OutData%StoredForces,2) + DO i1 = LBOUND(OutData%StoredForces,1), UBOUND(OutData%StoredForces,1) + OutData%StoredForces(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StoredMoments not allocated Int_Xferred = Int_Xferred + 1 @@ -14123,15 +13932,14 @@ SUBROUTINE AD14_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StoredMoments.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%StoredMoments)>0) OutData%StoredMoments = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%StoredMoments))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%StoredMoments) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%StoredMoments,3), UBOUND(OutData%StoredMoments,3) + DO i2 = LBOUND(OutData%StoredMoments,2), UBOUND(OutData%StoredMoments,2) + DO i1 = LBOUND(OutData%StoredMoments,1), UBOUND(OutData%StoredMoments,1) + OutData%StoredMoments(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF END SUBROUTINE AD14_UnPackMisc @@ -14485,58 +14293,58 @@ SUBROUTINE AD14_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%Title) - IntKiBuf(Int_Xferred) = ICHAR(InData%Title(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%SIUnit , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Echo , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%MultiTab , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%LinearizeFlag , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%OutputPlottingInfo , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%UseDWM , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TwoPiNB - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumBl - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NBlInpSt - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%ElemPrn , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%DStall , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PMoment , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Reynolds , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%DynInfl , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Wake , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Swirl , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DtAero - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HubRad - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UnEc - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UnElem - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UnWndOut - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MAXICOUNT - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%WrOptFile , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DEFAULT_Wind - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%Title) + IntKiBuf(Int_Xferred) = ICHAR(InData%Title(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%SIUnit, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%Echo, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%MultiTab, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%LinearizeFlag, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%OutputPlottingInfo, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%UseDWM, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TwoPiNB + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumBl + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NBlInpSt + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%ElemPrn, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%DStall, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%PMoment, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%Reynolds, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%DynInfl, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%Wake, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%Swirl, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DtAero + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HubRad + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%UnEc + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%UnElem + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%UnWndOut + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MAXICOUNT + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%WrOptFile, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DEFAULT_Wind + Int_Xferred = Int_Xferred + 1 CALL AD14_Packairfoilparms( Re_Buf, Db_Buf, Int_Buf, InData%AirFoil, ErrStat2, ErrMsg2, OnlySize ) ! AirFoil CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -14832,12 +14640,6 @@ SUBROUTINE AD14_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'AD14_UnPackParam' @@ -14851,58 +14653,58 @@ SUBROUTINE AD14_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%Title) - OutData%Title(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%SIUnit = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%Echo = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%MultiTab = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%LinearizeFlag = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%OutputPlottingInfo = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%UseDWM = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%TwoPiNB = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NumBl = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NBlInpSt = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%ElemPrn = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%DStall = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%PMoment = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%Reynolds = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%DynInfl = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%Wake = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%Swirl = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%DtAero = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%HubRad = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%UnEc = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%UnElem = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%UnWndOut = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%MAXICOUNT = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%WrOptFile = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%DEFAULT_Wind = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%Title) + OutData%Title(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%SIUnit = TRANSFER(IntKiBuf(Int_Xferred), OutData%SIUnit) + Int_Xferred = Int_Xferred + 1 + OutData%Echo = TRANSFER(IntKiBuf(Int_Xferred), OutData%Echo) + Int_Xferred = Int_Xferred + 1 + OutData%MultiTab = TRANSFER(IntKiBuf(Int_Xferred), OutData%MultiTab) + Int_Xferred = Int_Xferred + 1 + OutData%LinearizeFlag = TRANSFER(IntKiBuf(Int_Xferred), OutData%LinearizeFlag) + Int_Xferred = Int_Xferred + 1 + OutData%OutputPlottingInfo = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutputPlottingInfo) + Int_Xferred = Int_Xferred + 1 + OutData%UseDWM = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseDWM) + Int_Xferred = Int_Xferred + 1 + OutData%TwoPiNB = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NumBl = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NBlInpSt = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ElemPrn = TRANSFER(IntKiBuf(Int_Xferred), OutData%ElemPrn) + Int_Xferred = Int_Xferred + 1 + OutData%DStall = TRANSFER(IntKiBuf(Int_Xferred), OutData%DStall) + Int_Xferred = Int_Xferred + 1 + OutData%PMoment = TRANSFER(IntKiBuf(Int_Xferred), OutData%PMoment) + Int_Xferred = Int_Xferred + 1 + OutData%Reynolds = TRANSFER(IntKiBuf(Int_Xferred), OutData%Reynolds) + Int_Xferred = Int_Xferred + 1 + OutData%DynInfl = TRANSFER(IntKiBuf(Int_Xferred), OutData%DynInfl) + Int_Xferred = Int_Xferred + 1 + OutData%Wake = TRANSFER(IntKiBuf(Int_Xferred), OutData%Wake) + Int_Xferred = Int_Xferred + 1 + OutData%Swirl = TRANSFER(IntKiBuf(Int_Xferred), OutData%Swirl) + Int_Xferred = Int_Xferred + 1 + OutData%DtAero = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%HubRad = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%UnEc = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%UnElem = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%UnWndOut = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%MAXICOUNT = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WrOptFile = TRANSFER(IntKiBuf(Int_Xferred), OutData%WrOptFile) + Int_Xferred = Int_Xferred + 1 + OutData%DEFAULT_Wind = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -15640,8 +15442,12 @@ SUBROUTINE AD14_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MulTabLoc,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%MulTabLoc)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MulTabLoc))-1 ) = PACK(InData%MulTabLoc,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MulTabLoc) + DO i2 = LBOUND(InData%MulTabLoc,2), UBOUND(InData%MulTabLoc,2) + DO i1 = LBOUND(InData%MulTabLoc,1), UBOUND(InData%MulTabLoc,1) + ReKiBuf(Re_Xferred) = InData%MulTabLoc(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%InflowVelocity) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -15656,11 +15462,17 @@ SUBROUTINE AD14_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InflowVelocity,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%InflowVelocity)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%InflowVelocity))-1 ) = PACK(InData%InflowVelocity,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%InflowVelocity) + DO i2 = LBOUND(InData%InflowVelocity,2), UBOUND(InData%InflowVelocity,2) + DO i1 = LBOUND(InData%InflowVelocity,1), UBOUND(InData%InflowVelocity,1) + ReKiBuf(Re_Xferred) = InData%InflowVelocity(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AvgInfVel))-1 ) = PACK(InData%AvgInfVel,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AvgInfVel) + DO i1 = LBOUND(InData%AvgInfVel,1), UBOUND(InData%AvgInfVel,1) + ReKiBuf(Re_Xferred) = InData%AvgInfVel(i1) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE AD14_PackInput SUBROUTINE AD14_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -15676,12 +15488,6 @@ SUBROUTINE AD14_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -15849,15 +15655,12 @@ SUBROUTINE AD14_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MulTabLoc.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%MulTabLoc)>0) OutData%MulTabLoc = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MulTabLoc))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%MulTabLoc) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%MulTabLoc,2), UBOUND(OutData%MulTabLoc,2) + DO i1 = LBOUND(OutData%MulTabLoc,1), UBOUND(OutData%MulTabLoc,1) + OutData%MulTabLoc(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InflowVelocity not allocated Int_Xferred = Int_Xferred + 1 @@ -15875,27 +15678,19 @@ SUBROUTINE AD14_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InflowVelocity.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%InflowVelocity)>0) OutData%InflowVelocity = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%InflowVelocity))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%InflowVelocity) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%InflowVelocity,2), UBOUND(OutData%InflowVelocity,2) + DO i1 = LBOUND(OutData%InflowVelocity,1), UBOUND(OutData%InflowVelocity,1) + OutData%InflowVelocity(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF i1_l = LBOUND(OutData%AvgInfVel,1) i1_u = UBOUND(OutData%AvgInfVel,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%AvgInfVel = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AvgInfVel))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AvgInfVel) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AvgInfVel,1), UBOUND(OutData%AvgInfVel,1) + OutData%AvgInfVel(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE AD14_UnPackInput SUBROUTINE AD14_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -16139,12 +15934,6 @@ SUBROUTINE AD14_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -16332,16 +16121,16 @@ SUBROUTINE AD14_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'AD14_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts INTEGER :: i11 ! dim1 level 1 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i12 ! dim2 level 1 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -16354,9 +16143,11 @@ SUBROUTINE AD14_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) IF (ALLOCATED(u_out%InputMarkers) .AND. ALLOCATED(u1%InputMarkers)) THEN - DO i01 = LBOUND(u_out%InputMarkers,1),UBOUND(u_out%InputMarkers,1) - CALL MeshExtrapInterp1(u1%InputMarkers(i01), u2%InputMarkers(i01), tin, u_out%InputMarkers(i01), tin_out, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(u_out%InputMarkers,1),UBOUND(u_out%InputMarkers,1) + CALL MeshExtrapInterp1(u1%InputMarkers(i1), u2%InputMarkers(i1), tin, u_out%InputMarkers(i1), tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) ENDDO END IF ! check if allocated @@ -16364,230 +16155,180 @@ SUBROUTINE AD14_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(u_out%TurbineComponents%Blade) .AND. ALLOCATED(u1%TurbineComponents%Blade)) THEN DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Blade(i11)%Position,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Blade(i11)%Position,1))) - b1 = -(u1%TurbineComponents%Blade(i11)%Position - u2%TurbineComponents%Blade(i11)%Position)/t(2) - u_out%TurbineComponents%Blade(i11)%Position = u1%TurbineComponents%Blade(i11)%Position + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%TurbineComponents%Blade(i11)%Position,1),UBOUND(u_out%TurbineComponents%Blade(i11)%Position,1) + b = -(u1%TurbineComponents%Blade(i11)%Position(i1) - u2%TurbineComponents%Blade(i11)%Position(i1)) + u_out%TurbineComponents%Blade(i11)%Position(i1) = u1%TurbineComponents%Blade(i11)%Position(i1) + b * ScaleFactor + END DO ENDDO DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) - ALLOCATE(b2(SIZE(u_out%TurbineComponents%Blade(i11)%Orientation,1),SIZE(u_out%TurbineComponents%Blade(i11)%Orientation,2) )) - ALLOCATE(c2(SIZE(u_out%TurbineComponents%Blade(i11)%Orientation,1),SIZE(u_out%TurbineComponents%Blade(i11)%Orientation,2) )) - b2 = -(u1%TurbineComponents%Blade(i11)%Orientation - u2%TurbineComponents%Blade(i11)%Orientation)/t(2) - u_out%TurbineComponents%Blade(i11)%Orientation = u1%TurbineComponents%Blade(i11)%Orientation + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%TurbineComponents%Blade(i11)%Orientation,2),UBOUND(u_out%TurbineComponents%Blade(i11)%Orientation,2) + DO i1 = LBOUND(u_out%TurbineComponents%Blade(i11)%Orientation,1),UBOUND(u_out%TurbineComponents%Blade(i11)%Orientation,1) + b = -(u1%TurbineComponents%Blade(i11)%Orientation(i1,i2) - u2%TurbineComponents%Blade(i11)%Orientation(i1,i2)) + u_out%TurbineComponents%Blade(i11)%Orientation(i1,i2) = u1%TurbineComponents%Blade(i11)%Orientation(i1,i2) + b * ScaleFactor + END DO + END DO ENDDO DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Blade(i11)%TranslationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Blade(i11)%TranslationVel,1))) - b1 = -(u1%TurbineComponents%Blade(i11)%TranslationVel - u2%TurbineComponents%Blade(i11)%TranslationVel)/t(2) - u_out%TurbineComponents%Blade(i11)%TranslationVel = u1%TurbineComponents%Blade(i11)%TranslationVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%TurbineComponents%Blade(i11)%TranslationVel,1),UBOUND(u_out%TurbineComponents%Blade(i11)%TranslationVel,1) + b = -(u1%TurbineComponents%Blade(i11)%TranslationVel(i1) - u2%TurbineComponents%Blade(i11)%TranslationVel(i1)) + u_out%TurbineComponents%Blade(i11)%TranslationVel(i1) = u1%TurbineComponents%Blade(i11)%TranslationVel(i1) + b * ScaleFactor + END DO ENDDO DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Blade(i11)%RotationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Blade(i11)%RotationVel,1))) - b1 = -(u1%TurbineComponents%Blade(i11)%RotationVel - u2%TurbineComponents%Blade(i11)%RotationVel)/t(2) - u_out%TurbineComponents%Blade(i11)%RotationVel = u1%TurbineComponents%Blade(i11)%RotationVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%TurbineComponents%Blade(i11)%RotationVel,1),UBOUND(u_out%TurbineComponents%Blade(i11)%RotationVel,1) + b = -(u1%TurbineComponents%Blade(i11)%RotationVel(i1) - u2%TurbineComponents%Blade(i11)%RotationVel(i1)) + u_out%TurbineComponents%Blade(i11)%RotationVel(i1) = u1%TurbineComponents%Blade(i11)%RotationVel(i1) + b * ScaleFactor + END DO ENDDO END IF ! check if allocated - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Hub%Position,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Hub%Position,1))) - b1 = -(u1%TurbineComponents%Hub%Position - u2%TurbineComponents%Hub%Position)/t(2) - u_out%TurbineComponents%Hub%Position = u1%TurbineComponents%Hub%Position + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b2(SIZE(u_out%TurbineComponents%Hub%Orientation,1),SIZE(u_out%TurbineComponents%Hub%Orientation,2) )) - ALLOCATE(c2(SIZE(u_out%TurbineComponents%Hub%Orientation,1),SIZE(u_out%TurbineComponents%Hub%Orientation,2) )) - b2 = -(u1%TurbineComponents%Hub%Orientation - u2%TurbineComponents%Hub%Orientation)/t(2) - u_out%TurbineComponents%Hub%Orientation = u1%TurbineComponents%Hub%Orientation + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Hub%TranslationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Hub%TranslationVel,1))) - b1 = -(u1%TurbineComponents%Hub%TranslationVel - u2%TurbineComponents%Hub%TranslationVel)/t(2) - u_out%TurbineComponents%Hub%TranslationVel = u1%TurbineComponents%Hub%TranslationVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Hub%RotationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Hub%RotationVel,1))) - b1 = -(u1%TurbineComponents%Hub%RotationVel - u2%TurbineComponents%Hub%RotationVel)/t(2) - u_out%TurbineComponents%Hub%RotationVel = u1%TurbineComponents%Hub%RotationVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%RotorFurl%Position,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%RotorFurl%Position,1))) - b1 = -(u1%TurbineComponents%RotorFurl%Position - u2%TurbineComponents%RotorFurl%Position)/t(2) - u_out%TurbineComponents%RotorFurl%Position = u1%TurbineComponents%RotorFurl%Position + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b2(SIZE(u_out%TurbineComponents%RotorFurl%Orientation,1),SIZE(u_out%TurbineComponents%RotorFurl%Orientation,2) )) - ALLOCATE(c2(SIZE(u_out%TurbineComponents%RotorFurl%Orientation,1),SIZE(u_out%TurbineComponents%RotorFurl%Orientation,2) )) - b2 = -(u1%TurbineComponents%RotorFurl%Orientation - u2%TurbineComponents%RotorFurl%Orientation)/t(2) - u_out%TurbineComponents%RotorFurl%Orientation = u1%TurbineComponents%RotorFurl%Orientation + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%RotorFurl%TranslationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%RotorFurl%TranslationVel,1))) - b1 = -(u1%TurbineComponents%RotorFurl%TranslationVel - u2%TurbineComponents%RotorFurl%TranslationVel)/t(2) - u_out%TurbineComponents%RotorFurl%TranslationVel = u1%TurbineComponents%RotorFurl%TranslationVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%RotorFurl%RotationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%RotorFurl%RotationVel,1))) - b1 = -(u1%TurbineComponents%RotorFurl%RotationVel - u2%TurbineComponents%RotorFurl%RotationVel)/t(2) - u_out%TurbineComponents%RotorFurl%RotationVel = u1%TurbineComponents%RotorFurl%RotationVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Nacelle%Position,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Nacelle%Position,1))) - b1 = -(u1%TurbineComponents%Nacelle%Position - u2%TurbineComponents%Nacelle%Position)/t(2) - u_out%TurbineComponents%Nacelle%Position = u1%TurbineComponents%Nacelle%Position + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b2(SIZE(u_out%TurbineComponents%Nacelle%Orientation,1),SIZE(u_out%TurbineComponents%Nacelle%Orientation,2) )) - ALLOCATE(c2(SIZE(u_out%TurbineComponents%Nacelle%Orientation,1),SIZE(u_out%TurbineComponents%Nacelle%Orientation,2) )) - b2 = -(u1%TurbineComponents%Nacelle%Orientation - u2%TurbineComponents%Nacelle%Orientation)/t(2) - u_out%TurbineComponents%Nacelle%Orientation = u1%TurbineComponents%Nacelle%Orientation + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Nacelle%TranslationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Nacelle%TranslationVel,1))) - b1 = -(u1%TurbineComponents%Nacelle%TranslationVel - u2%TurbineComponents%Nacelle%TranslationVel)/t(2) - u_out%TurbineComponents%Nacelle%TranslationVel = u1%TurbineComponents%Nacelle%TranslationVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Nacelle%RotationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Nacelle%RotationVel,1))) - b1 = -(u1%TurbineComponents%Nacelle%RotationVel - u2%TurbineComponents%Nacelle%RotationVel)/t(2) - u_out%TurbineComponents%Nacelle%RotationVel = u1%TurbineComponents%Nacelle%RotationVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%TailFin%Position,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%TailFin%Position,1))) - b1 = -(u1%TurbineComponents%TailFin%Position - u2%TurbineComponents%TailFin%Position)/t(2) - u_out%TurbineComponents%TailFin%Position = u1%TurbineComponents%TailFin%Position + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b2(SIZE(u_out%TurbineComponents%TailFin%Orientation,1),SIZE(u_out%TurbineComponents%TailFin%Orientation,2) )) - ALLOCATE(c2(SIZE(u_out%TurbineComponents%TailFin%Orientation,1),SIZE(u_out%TurbineComponents%TailFin%Orientation,2) )) - b2 = -(u1%TurbineComponents%TailFin%Orientation - u2%TurbineComponents%TailFin%Orientation)/t(2) - u_out%TurbineComponents%TailFin%Orientation = u1%TurbineComponents%TailFin%Orientation + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%TailFin%TranslationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%TailFin%TranslationVel,1))) - b1 = -(u1%TurbineComponents%TailFin%TranslationVel - u2%TurbineComponents%TailFin%TranslationVel)/t(2) - u_out%TurbineComponents%TailFin%TranslationVel = u1%TurbineComponents%TailFin%TranslationVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%TailFin%RotationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%TailFin%RotationVel,1))) - b1 = -(u1%TurbineComponents%TailFin%RotationVel - u2%TurbineComponents%TailFin%RotationVel)/t(2) - u_out%TurbineComponents%TailFin%RotationVel = u1%TurbineComponents%TailFin%RotationVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Tower%Position,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Tower%Position,1))) - b1 = -(u1%TurbineComponents%Tower%Position - u2%TurbineComponents%Tower%Position)/t(2) - u_out%TurbineComponents%Tower%Position = u1%TurbineComponents%Tower%Position + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b2(SIZE(u_out%TurbineComponents%Tower%Orientation,1),SIZE(u_out%TurbineComponents%Tower%Orientation,2) )) - ALLOCATE(c2(SIZE(u_out%TurbineComponents%Tower%Orientation,1),SIZE(u_out%TurbineComponents%Tower%Orientation,2) )) - b2 = -(u1%TurbineComponents%Tower%Orientation - u2%TurbineComponents%Tower%Orientation)/t(2) - u_out%TurbineComponents%Tower%Orientation = u1%TurbineComponents%Tower%Orientation + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Tower%TranslationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Tower%TranslationVel,1))) - b1 = -(u1%TurbineComponents%Tower%TranslationVel - u2%TurbineComponents%Tower%TranslationVel)/t(2) - u_out%TurbineComponents%Tower%TranslationVel = u1%TurbineComponents%Tower%TranslationVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Tower%RotationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Tower%RotationVel,1))) - b1 = -(u1%TurbineComponents%Tower%RotationVel - u2%TurbineComponents%Tower%RotationVel)/t(2) - u_out%TurbineComponents%Tower%RotationVel = u1%TurbineComponents%Tower%RotationVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%SubStructure%Position,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%SubStructure%Position,1))) - b1 = -(u1%TurbineComponents%SubStructure%Position - u2%TurbineComponents%SubStructure%Position)/t(2) - u_out%TurbineComponents%SubStructure%Position = u1%TurbineComponents%SubStructure%Position + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b2(SIZE(u_out%TurbineComponents%SubStructure%Orientation,1),SIZE(u_out%TurbineComponents%SubStructure%Orientation,2) )) - ALLOCATE(c2(SIZE(u_out%TurbineComponents%SubStructure%Orientation,1),SIZE(u_out%TurbineComponents%SubStructure%Orientation,2) )) - b2 = -(u1%TurbineComponents%SubStructure%Orientation - u2%TurbineComponents%SubStructure%Orientation)/t(2) - u_out%TurbineComponents%SubStructure%Orientation = u1%TurbineComponents%SubStructure%Orientation + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%SubStructure%TranslationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%SubStructure%TranslationVel,1))) - b1 = -(u1%TurbineComponents%SubStructure%TranslationVel - u2%TurbineComponents%SubStructure%TranslationVel)/t(2) - u_out%TurbineComponents%SubStructure%TranslationVel = u1%TurbineComponents%SubStructure%TranslationVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%SubStructure%RotationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%SubStructure%RotationVel,1))) - b1 = -(u1%TurbineComponents%SubStructure%RotationVel - u2%TurbineComponents%SubStructure%RotationVel)/t(2) - u_out%TurbineComponents%SubStructure%RotationVel = u1%TurbineComponents%SubStructure%RotationVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Foundation%Position,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Foundation%Position,1))) - b1 = -(u1%TurbineComponents%Foundation%Position - u2%TurbineComponents%Foundation%Position)/t(2) - u_out%TurbineComponents%Foundation%Position = u1%TurbineComponents%Foundation%Position + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b2(SIZE(u_out%TurbineComponents%Foundation%Orientation,1),SIZE(u_out%TurbineComponents%Foundation%Orientation,2) )) - ALLOCATE(c2(SIZE(u_out%TurbineComponents%Foundation%Orientation,1),SIZE(u_out%TurbineComponents%Foundation%Orientation,2) )) - b2 = -(u1%TurbineComponents%Foundation%Orientation - u2%TurbineComponents%Foundation%Orientation)/t(2) - u_out%TurbineComponents%Foundation%Orientation = u1%TurbineComponents%Foundation%Orientation + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Foundation%TranslationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Foundation%TranslationVel,1))) - b1 = -(u1%TurbineComponents%Foundation%TranslationVel - u2%TurbineComponents%Foundation%TranslationVel)/t(2) - u_out%TurbineComponents%Foundation%TranslationVel = u1%TurbineComponents%Foundation%TranslationVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Foundation%RotationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Foundation%RotationVel,1))) - b1 = -(u1%TurbineComponents%Foundation%RotationVel - u2%TurbineComponents%Foundation%RotationVel)/t(2) - u_out%TurbineComponents%Foundation%RotationVel = u1%TurbineComponents%Foundation%RotationVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - b0 = -(u1%TurbineComponents%BladeLength - u2%TurbineComponents%BladeLength)/t(2) - u_out%TurbineComponents%BladeLength = u1%TurbineComponents%BladeLength + b0 * t_out + DO i1 = LBOUND(u_out%TurbineComponents%Hub%Position,1),UBOUND(u_out%TurbineComponents%Hub%Position,1) + b = -(u1%TurbineComponents%Hub%Position(i1) - u2%TurbineComponents%Hub%Position(i1)) + u_out%TurbineComponents%Hub%Position(i1) = u1%TurbineComponents%Hub%Position(i1) + b * ScaleFactor + END DO + DO i2 = LBOUND(u_out%TurbineComponents%Hub%Orientation,2),UBOUND(u_out%TurbineComponents%Hub%Orientation,2) + DO i1 = LBOUND(u_out%TurbineComponents%Hub%Orientation,1),UBOUND(u_out%TurbineComponents%Hub%Orientation,1) + b = -(u1%TurbineComponents%Hub%Orientation(i1,i2) - u2%TurbineComponents%Hub%Orientation(i1,i2)) + u_out%TurbineComponents%Hub%Orientation(i1,i2) = u1%TurbineComponents%Hub%Orientation(i1,i2) + b * ScaleFactor + END DO + END DO + DO i1 = LBOUND(u_out%TurbineComponents%Hub%TranslationVel,1),UBOUND(u_out%TurbineComponents%Hub%TranslationVel,1) + b = -(u1%TurbineComponents%Hub%TranslationVel(i1) - u2%TurbineComponents%Hub%TranslationVel(i1)) + u_out%TurbineComponents%Hub%TranslationVel(i1) = u1%TurbineComponents%Hub%TranslationVel(i1) + b * ScaleFactor + END DO + DO i1 = LBOUND(u_out%TurbineComponents%Hub%RotationVel,1),UBOUND(u_out%TurbineComponents%Hub%RotationVel,1) + b = -(u1%TurbineComponents%Hub%RotationVel(i1) - u2%TurbineComponents%Hub%RotationVel(i1)) + u_out%TurbineComponents%Hub%RotationVel(i1) = u1%TurbineComponents%Hub%RotationVel(i1) + b * ScaleFactor + END DO + DO i1 = LBOUND(u_out%TurbineComponents%RotorFurl%Position,1),UBOUND(u_out%TurbineComponents%RotorFurl%Position,1) + b = -(u1%TurbineComponents%RotorFurl%Position(i1) - u2%TurbineComponents%RotorFurl%Position(i1)) + u_out%TurbineComponents%RotorFurl%Position(i1) = u1%TurbineComponents%RotorFurl%Position(i1) + b * ScaleFactor + END DO + DO i2 = LBOUND(u_out%TurbineComponents%RotorFurl%Orientation,2),UBOUND(u_out%TurbineComponents%RotorFurl%Orientation,2) + DO i1 = LBOUND(u_out%TurbineComponents%RotorFurl%Orientation,1),UBOUND(u_out%TurbineComponents%RotorFurl%Orientation,1) + b = -(u1%TurbineComponents%RotorFurl%Orientation(i1,i2) - u2%TurbineComponents%RotorFurl%Orientation(i1,i2)) + u_out%TurbineComponents%RotorFurl%Orientation(i1,i2) = u1%TurbineComponents%RotorFurl%Orientation(i1,i2) + b * ScaleFactor + END DO + END DO + DO i1 = LBOUND(u_out%TurbineComponents%RotorFurl%TranslationVel,1),UBOUND(u_out%TurbineComponents%RotorFurl%TranslationVel,1) + b = -(u1%TurbineComponents%RotorFurl%TranslationVel(i1) - u2%TurbineComponents%RotorFurl%TranslationVel(i1)) + u_out%TurbineComponents%RotorFurl%TranslationVel(i1) = u1%TurbineComponents%RotorFurl%TranslationVel(i1) + b * ScaleFactor + END DO + DO i1 = LBOUND(u_out%TurbineComponents%RotorFurl%RotationVel,1),UBOUND(u_out%TurbineComponents%RotorFurl%RotationVel,1) + b = -(u1%TurbineComponents%RotorFurl%RotationVel(i1) - u2%TurbineComponents%RotorFurl%RotationVel(i1)) + u_out%TurbineComponents%RotorFurl%RotationVel(i1) = u1%TurbineComponents%RotorFurl%RotationVel(i1) + b * ScaleFactor + END DO + DO i1 = LBOUND(u_out%TurbineComponents%Nacelle%Position,1),UBOUND(u_out%TurbineComponents%Nacelle%Position,1) + b = -(u1%TurbineComponents%Nacelle%Position(i1) - u2%TurbineComponents%Nacelle%Position(i1)) + u_out%TurbineComponents%Nacelle%Position(i1) = u1%TurbineComponents%Nacelle%Position(i1) + b * ScaleFactor + END DO + DO i2 = LBOUND(u_out%TurbineComponents%Nacelle%Orientation,2),UBOUND(u_out%TurbineComponents%Nacelle%Orientation,2) + DO i1 = LBOUND(u_out%TurbineComponents%Nacelle%Orientation,1),UBOUND(u_out%TurbineComponents%Nacelle%Orientation,1) + b = -(u1%TurbineComponents%Nacelle%Orientation(i1,i2) - u2%TurbineComponents%Nacelle%Orientation(i1,i2)) + u_out%TurbineComponents%Nacelle%Orientation(i1,i2) = u1%TurbineComponents%Nacelle%Orientation(i1,i2) + b * ScaleFactor + END DO + END DO + DO i1 = LBOUND(u_out%TurbineComponents%Nacelle%TranslationVel,1),UBOUND(u_out%TurbineComponents%Nacelle%TranslationVel,1) + b = -(u1%TurbineComponents%Nacelle%TranslationVel(i1) - u2%TurbineComponents%Nacelle%TranslationVel(i1)) + u_out%TurbineComponents%Nacelle%TranslationVel(i1) = u1%TurbineComponents%Nacelle%TranslationVel(i1) + b * ScaleFactor + END DO + DO i1 = LBOUND(u_out%TurbineComponents%Nacelle%RotationVel,1),UBOUND(u_out%TurbineComponents%Nacelle%RotationVel,1) + b = -(u1%TurbineComponents%Nacelle%RotationVel(i1) - u2%TurbineComponents%Nacelle%RotationVel(i1)) + u_out%TurbineComponents%Nacelle%RotationVel(i1) = u1%TurbineComponents%Nacelle%RotationVel(i1) + b * ScaleFactor + END DO + DO i1 = LBOUND(u_out%TurbineComponents%TailFin%Position,1),UBOUND(u_out%TurbineComponents%TailFin%Position,1) + b = -(u1%TurbineComponents%TailFin%Position(i1) - u2%TurbineComponents%TailFin%Position(i1)) + u_out%TurbineComponents%TailFin%Position(i1) = u1%TurbineComponents%TailFin%Position(i1) + b * ScaleFactor + END DO + DO i2 = LBOUND(u_out%TurbineComponents%TailFin%Orientation,2),UBOUND(u_out%TurbineComponents%TailFin%Orientation,2) + DO i1 = LBOUND(u_out%TurbineComponents%TailFin%Orientation,1),UBOUND(u_out%TurbineComponents%TailFin%Orientation,1) + b = -(u1%TurbineComponents%TailFin%Orientation(i1,i2) - u2%TurbineComponents%TailFin%Orientation(i1,i2)) + u_out%TurbineComponents%TailFin%Orientation(i1,i2) = u1%TurbineComponents%TailFin%Orientation(i1,i2) + b * ScaleFactor + END DO + END DO + DO i1 = LBOUND(u_out%TurbineComponents%TailFin%TranslationVel,1),UBOUND(u_out%TurbineComponents%TailFin%TranslationVel,1) + b = -(u1%TurbineComponents%TailFin%TranslationVel(i1) - u2%TurbineComponents%TailFin%TranslationVel(i1)) + u_out%TurbineComponents%TailFin%TranslationVel(i1) = u1%TurbineComponents%TailFin%TranslationVel(i1) + b * ScaleFactor + END DO + DO i1 = LBOUND(u_out%TurbineComponents%TailFin%RotationVel,1),UBOUND(u_out%TurbineComponents%TailFin%RotationVel,1) + b = -(u1%TurbineComponents%TailFin%RotationVel(i1) - u2%TurbineComponents%TailFin%RotationVel(i1)) + u_out%TurbineComponents%TailFin%RotationVel(i1) = u1%TurbineComponents%TailFin%RotationVel(i1) + b * ScaleFactor + END DO + DO i1 = LBOUND(u_out%TurbineComponents%Tower%Position,1),UBOUND(u_out%TurbineComponents%Tower%Position,1) + b = -(u1%TurbineComponents%Tower%Position(i1) - u2%TurbineComponents%Tower%Position(i1)) + u_out%TurbineComponents%Tower%Position(i1) = u1%TurbineComponents%Tower%Position(i1) + b * ScaleFactor + END DO + DO i2 = LBOUND(u_out%TurbineComponents%Tower%Orientation,2),UBOUND(u_out%TurbineComponents%Tower%Orientation,2) + DO i1 = LBOUND(u_out%TurbineComponents%Tower%Orientation,1),UBOUND(u_out%TurbineComponents%Tower%Orientation,1) + b = -(u1%TurbineComponents%Tower%Orientation(i1,i2) - u2%TurbineComponents%Tower%Orientation(i1,i2)) + u_out%TurbineComponents%Tower%Orientation(i1,i2) = u1%TurbineComponents%Tower%Orientation(i1,i2) + b * ScaleFactor + END DO + END DO + DO i1 = LBOUND(u_out%TurbineComponents%Tower%TranslationVel,1),UBOUND(u_out%TurbineComponents%Tower%TranslationVel,1) + b = -(u1%TurbineComponents%Tower%TranslationVel(i1) - u2%TurbineComponents%Tower%TranslationVel(i1)) + u_out%TurbineComponents%Tower%TranslationVel(i1) = u1%TurbineComponents%Tower%TranslationVel(i1) + b * ScaleFactor + END DO + DO i1 = LBOUND(u_out%TurbineComponents%Tower%RotationVel,1),UBOUND(u_out%TurbineComponents%Tower%RotationVel,1) + b = -(u1%TurbineComponents%Tower%RotationVel(i1) - u2%TurbineComponents%Tower%RotationVel(i1)) + u_out%TurbineComponents%Tower%RotationVel(i1) = u1%TurbineComponents%Tower%RotationVel(i1) + b * ScaleFactor + END DO + DO i1 = LBOUND(u_out%TurbineComponents%SubStructure%Position,1),UBOUND(u_out%TurbineComponents%SubStructure%Position,1) + b = -(u1%TurbineComponents%SubStructure%Position(i1) - u2%TurbineComponents%SubStructure%Position(i1)) + u_out%TurbineComponents%SubStructure%Position(i1) = u1%TurbineComponents%SubStructure%Position(i1) + b * ScaleFactor + END DO + DO i2 = LBOUND(u_out%TurbineComponents%SubStructure%Orientation,2),UBOUND(u_out%TurbineComponents%SubStructure%Orientation,2) + DO i1 = LBOUND(u_out%TurbineComponents%SubStructure%Orientation,1),UBOUND(u_out%TurbineComponents%SubStructure%Orientation,1) + b = -(u1%TurbineComponents%SubStructure%Orientation(i1,i2) - u2%TurbineComponents%SubStructure%Orientation(i1,i2)) + u_out%TurbineComponents%SubStructure%Orientation(i1,i2) = u1%TurbineComponents%SubStructure%Orientation(i1,i2) + b * ScaleFactor + END DO + END DO + DO i1 = LBOUND(u_out%TurbineComponents%SubStructure%TranslationVel,1),UBOUND(u_out%TurbineComponents%SubStructure%TranslationVel,1) + b = -(u1%TurbineComponents%SubStructure%TranslationVel(i1) - u2%TurbineComponents%SubStructure%TranslationVel(i1)) + u_out%TurbineComponents%SubStructure%TranslationVel(i1) = u1%TurbineComponents%SubStructure%TranslationVel(i1) + b * ScaleFactor + END DO + DO i1 = LBOUND(u_out%TurbineComponents%SubStructure%RotationVel,1),UBOUND(u_out%TurbineComponents%SubStructure%RotationVel,1) + b = -(u1%TurbineComponents%SubStructure%RotationVel(i1) - u2%TurbineComponents%SubStructure%RotationVel(i1)) + u_out%TurbineComponents%SubStructure%RotationVel(i1) = u1%TurbineComponents%SubStructure%RotationVel(i1) + b * ScaleFactor + END DO + DO i1 = LBOUND(u_out%TurbineComponents%Foundation%Position,1),UBOUND(u_out%TurbineComponents%Foundation%Position,1) + b = -(u1%TurbineComponents%Foundation%Position(i1) - u2%TurbineComponents%Foundation%Position(i1)) + u_out%TurbineComponents%Foundation%Position(i1) = u1%TurbineComponents%Foundation%Position(i1) + b * ScaleFactor + END DO + DO i2 = LBOUND(u_out%TurbineComponents%Foundation%Orientation,2),UBOUND(u_out%TurbineComponents%Foundation%Orientation,2) + DO i1 = LBOUND(u_out%TurbineComponents%Foundation%Orientation,1),UBOUND(u_out%TurbineComponents%Foundation%Orientation,1) + b = -(u1%TurbineComponents%Foundation%Orientation(i1,i2) - u2%TurbineComponents%Foundation%Orientation(i1,i2)) + u_out%TurbineComponents%Foundation%Orientation(i1,i2) = u1%TurbineComponents%Foundation%Orientation(i1,i2) + b * ScaleFactor + END DO + END DO + DO i1 = LBOUND(u_out%TurbineComponents%Foundation%TranslationVel,1),UBOUND(u_out%TurbineComponents%Foundation%TranslationVel,1) + b = -(u1%TurbineComponents%Foundation%TranslationVel(i1) - u2%TurbineComponents%Foundation%TranslationVel(i1)) + u_out%TurbineComponents%Foundation%TranslationVel(i1) = u1%TurbineComponents%Foundation%TranslationVel(i1) + b * ScaleFactor + END DO + DO i1 = LBOUND(u_out%TurbineComponents%Foundation%RotationVel,1),UBOUND(u_out%TurbineComponents%Foundation%RotationVel,1) + b = -(u1%TurbineComponents%Foundation%RotationVel(i1) - u2%TurbineComponents%Foundation%RotationVel(i1)) + u_out%TurbineComponents%Foundation%RotationVel(i1) = u1%TurbineComponents%Foundation%RotationVel(i1) + b * ScaleFactor + END DO + b = -(u1%TurbineComponents%BladeLength - u2%TurbineComponents%BladeLength) + u_out%TurbineComponents%BladeLength = u1%TurbineComponents%BladeLength + b * ScaleFactor IF (ALLOCATED(u_out%MulTabLoc) .AND. ALLOCATED(u1%MulTabLoc)) THEN - ALLOCATE(b2(SIZE(u_out%MulTabLoc,1),SIZE(u_out%MulTabLoc,2) )) - ALLOCATE(c2(SIZE(u_out%MulTabLoc,1),SIZE(u_out%MulTabLoc,2) )) - b2 = -(u1%MulTabLoc - u2%MulTabLoc)/t(2) - u_out%MulTabLoc = u1%MulTabLoc + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%MulTabLoc,2),UBOUND(u_out%MulTabLoc,2) + DO i1 = LBOUND(u_out%MulTabLoc,1),UBOUND(u_out%MulTabLoc,1) + b = -(u1%MulTabLoc(i1,i2) - u2%MulTabLoc(i1,i2)) + u_out%MulTabLoc(i1,i2) = u1%MulTabLoc(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated IF (ALLOCATED(u_out%InflowVelocity) .AND. ALLOCATED(u1%InflowVelocity)) THEN - ALLOCATE(b2(SIZE(u_out%InflowVelocity,1),SIZE(u_out%InflowVelocity,2) )) - ALLOCATE(c2(SIZE(u_out%InflowVelocity,1),SIZE(u_out%InflowVelocity,2) )) - b2 = -(u1%InflowVelocity - u2%InflowVelocity)/t(2) - u_out%InflowVelocity = u1%InflowVelocity + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%InflowVelocity,2),UBOUND(u_out%InflowVelocity,2) + DO i1 = LBOUND(u_out%InflowVelocity,1),UBOUND(u_out%InflowVelocity,1) + b = -(u1%InflowVelocity(i1,i2) - u2%InflowVelocity(i1,i2)) + u_out%InflowVelocity(i1,i2) = u1%InflowVelocity(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated - ALLOCATE(b1(SIZE(u_out%AvgInfVel,1))) - ALLOCATE(c1(SIZE(u_out%AvgInfVel,1))) - b1 = -(u1%AvgInfVel - u2%AvgInfVel)/t(2) - u_out%AvgInfVel = u1%AvgInfVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%AvgInfVel,1),UBOUND(u_out%AvgInfVel,1) + b = -(u1%AvgInfVel(i1) - u2%AvgInfVel(i1)) + u_out%AvgInfVel(i1) = u1%AvgInfVel(i1) + b * ScaleFactor + END DO END SUBROUTINE AD14_Input_ExtrapInterp1 @@ -16617,17 +16358,18 @@ SUBROUTINE AD14_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'AD14_Input_ExtrapInterp2' INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts INTEGER :: i11 ! dim1 level 1 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i12 ! dim2 level 1 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -16646,9 +16388,11 @@ SUBROUTINE AD14_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) IF (ALLOCATED(u_out%InputMarkers) .AND. ALLOCATED(u1%InputMarkers)) THEN - DO i01 = LBOUND(u_out%InputMarkers,1),UBOUND(u_out%InputMarkers,1) - CALL MeshExtrapInterp2(u1%InputMarkers(i01), u2%InputMarkers(i01), u3%InputMarkers(i01), tin, u_out%InputMarkers(i01), tin_out, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(u_out%InputMarkers,1),UBOUND(u_out%InputMarkers,1) + CALL MeshExtrapInterp2(u1%InputMarkers(i1), u2%InputMarkers(i1), u3%InputMarkers(i1), tin, u_out%InputMarkers(i1), tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) ENDDO END IF ! check if allocated @@ -16656,266 +16400,216 @@ SUBROUTINE AD14_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(u_out%TurbineComponents%Blade) .AND. ALLOCATED(u1%TurbineComponents%Blade)) THEN DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Blade(i11)%Position,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Blade(i11)%Position,1))) - b1 = (t(3)**2*(u1%TurbineComponents%Blade(i11)%Position - u2%TurbineComponents%Blade(i11)%Position) + t(2)**2*(-u1%TurbineComponents%Blade(i11)%Position + u3%TurbineComponents%Blade(i11)%Position))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%Blade(i11)%Position + t(3)*u2%TurbineComponents%Blade(i11)%Position - t(2)*u3%TurbineComponents%Blade(i11)%Position ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%Blade(i11)%Position = u1%TurbineComponents%Blade(i11)%Position + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%TurbineComponents%Blade(i11)%Position,1),UBOUND(u_out%TurbineComponents%Blade(i11)%Position,1) + b = (t(3)**2*(u1%TurbineComponents%Blade(i11)%Position(i1) - u2%TurbineComponents%Blade(i11)%Position(i1)) + t(2)**2*(-u1%TurbineComponents%Blade(i11)%Position(i1) + u3%TurbineComponents%Blade(i11)%Position(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%Blade(i11)%Position(i1) + t(3)*u2%TurbineComponents%Blade(i11)%Position(i1) - t(2)*u3%TurbineComponents%Blade(i11)%Position(i1) ) * scaleFactor + u_out%TurbineComponents%Blade(i11)%Position(i1) = u1%TurbineComponents%Blade(i11)%Position(i1) + b + c * t_out + END DO ENDDO DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) - ALLOCATE(b2(SIZE(u_out%TurbineComponents%Blade(i11)%Orientation,1),SIZE(u_out%TurbineComponents%Blade(i11)%Orientation,2) )) - ALLOCATE(c2(SIZE(u_out%TurbineComponents%Blade(i11)%Orientation,1),SIZE(u_out%TurbineComponents%Blade(i11)%Orientation,2) )) - b2 = (t(3)**2*(u1%TurbineComponents%Blade(i11)%Orientation - u2%TurbineComponents%Blade(i11)%Orientation) + t(2)**2*(-u1%TurbineComponents%Blade(i11)%Orientation + u3%TurbineComponents%Blade(i11)%Orientation))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%TurbineComponents%Blade(i11)%Orientation + t(3)*u2%TurbineComponents%Blade(i11)%Orientation - t(2)*u3%TurbineComponents%Blade(i11)%Orientation ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%Blade(i11)%Orientation = u1%TurbineComponents%Blade(i11)%Orientation + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%TurbineComponents%Blade(i11)%Orientation,2),UBOUND(u_out%TurbineComponents%Blade(i11)%Orientation,2) + DO i1 = LBOUND(u_out%TurbineComponents%Blade(i11)%Orientation,1),UBOUND(u_out%TurbineComponents%Blade(i11)%Orientation,1) + b = (t(3)**2*(u1%TurbineComponents%Blade(i11)%Orientation(i1,i2) - u2%TurbineComponents%Blade(i11)%Orientation(i1,i2)) + t(2)**2*(-u1%TurbineComponents%Blade(i11)%Orientation(i1,i2) + u3%TurbineComponents%Blade(i11)%Orientation(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%Blade(i11)%Orientation(i1,i2) + t(3)*u2%TurbineComponents%Blade(i11)%Orientation(i1,i2) - t(2)*u3%TurbineComponents%Blade(i11)%Orientation(i1,i2) ) * scaleFactor + u_out%TurbineComponents%Blade(i11)%Orientation(i1,i2) = u1%TurbineComponents%Blade(i11)%Orientation(i1,i2) + b + c * t_out + END DO + END DO ENDDO DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Blade(i11)%TranslationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Blade(i11)%TranslationVel,1))) - b1 = (t(3)**2*(u1%TurbineComponents%Blade(i11)%TranslationVel - u2%TurbineComponents%Blade(i11)%TranslationVel) + t(2)**2*(-u1%TurbineComponents%Blade(i11)%TranslationVel + u3%TurbineComponents%Blade(i11)%TranslationVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%Blade(i11)%TranslationVel + t(3)*u2%TurbineComponents%Blade(i11)%TranslationVel - t(2)*u3%TurbineComponents%Blade(i11)%TranslationVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%Blade(i11)%TranslationVel = u1%TurbineComponents%Blade(i11)%TranslationVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%TurbineComponents%Blade(i11)%TranslationVel,1),UBOUND(u_out%TurbineComponents%Blade(i11)%TranslationVel,1) + b = (t(3)**2*(u1%TurbineComponents%Blade(i11)%TranslationVel(i1) - u2%TurbineComponents%Blade(i11)%TranslationVel(i1)) + t(2)**2*(-u1%TurbineComponents%Blade(i11)%TranslationVel(i1) + u3%TurbineComponents%Blade(i11)%TranslationVel(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%Blade(i11)%TranslationVel(i1) + t(3)*u2%TurbineComponents%Blade(i11)%TranslationVel(i1) - t(2)*u3%TurbineComponents%Blade(i11)%TranslationVel(i1) ) * scaleFactor + u_out%TurbineComponents%Blade(i11)%TranslationVel(i1) = u1%TurbineComponents%Blade(i11)%TranslationVel(i1) + b + c * t_out + END DO ENDDO DO i11 = LBOUND(u_out%TurbineComponents%Blade,1),UBOUND(u_out%TurbineComponents%Blade,1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Blade(i11)%RotationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Blade(i11)%RotationVel,1))) - b1 = (t(3)**2*(u1%TurbineComponents%Blade(i11)%RotationVel - u2%TurbineComponents%Blade(i11)%RotationVel) + t(2)**2*(-u1%TurbineComponents%Blade(i11)%RotationVel + u3%TurbineComponents%Blade(i11)%RotationVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%Blade(i11)%RotationVel + t(3)*u2%TurbineComponents%Blade(i11)%RotationVel - t(2)*u3%TurbineComponents%Blade(i11)%RotationVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%Blade(i11)%RotationVel = u1%TurbineComponents%Blade(i11)%RotationVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%TurbineComponents%Blade(i11)%RotationVel,1),UBOUND(u_out%TurbineComponents%Blade(i11)%RotationVel,1) + b = (t(3)**2*(u1%TurbineComponents%Blade(i11)%RotationVel(i1) - u2%TurbineComponents%Blade(i11)%RotationVel(i1)) + t(2)**2*(-u1%TurbineComponents%Blade(i11)%RotationVel(i1) + u3%TurbineComponents%Blade(i11)%RotationVel(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%Blade(i11)%RotationVel(i1) + t(3)*u2%TurbineComponents%Blade(i11)%RotationVel(i1) - t(2)*u3%TurbineComponents%Blade(i11)%RotationVel(i1) ) * scaleFactor + u_out%TurbineComponents%Blade(i11)%RotationVel(i1) = u1%TurbineComponents%Blade(i11)%RotationVel(i1) + b + c * t_out + END DO ENDDO END IF ! check if allocated - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Hub%Position,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Hub%Position,1))) - b1 = (t(3)**2*(u1%TurbineComponents%Hub%Position - u2%TurbineComponents%Hub%Position) + t(2)**2*(-u1%TurbineComponents%Hub%Position + u3%TurbineComponents%Hub%Position))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%Hub%Position + t(3)*u2%TurbineComponents%Hub%Position - t(2)*u3%TurbineComponents%Hub%Position ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%Hub%Position = u1%TurbineComponents%Hub%Position + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b2(SIZE(u_out%TurbineComponents%Hub%Orientation,1),SIZE(u_out%TurbineComponents%Hub%Orientation,2) )) - ALLOCATE(c2(SIZE(u_out%TurbineComponents%Hub%Orientation,1),SIZE(u_out%TurbineComponents%Hub%Orientation,2) )) - b2 = (t(3)**2*(u1%TurbineComponents%Hub%Orientation - u2%TurbineComponents%Hub%Orientation) + t(2)**2*(-u1%TurbineComponents%Hub%Orientation + u3%TurbineComponents%Hub%Orientation))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%TurbineComponents%Hub%Orientation + t(3)*u2%TurbineComponents%Hub%Orientation - t(2)*u3%TurbineComponents%Hub%Orientation ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%Hub%Orientation = u1%TurbineComponents%Hub%Orientation + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Hub%TranslationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Hub%TranslationVel,1))) - b1 = (t(3)**2*(u1%TurbineComponents%Hub%TranslationVel - u2%TurbineComponents%Hub%TranslationVel) + t(2)**2*(-u1%TurbineComponents%Hub%TranslationVel + u3%TurbineComponents%Hub%TranslationVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%Hub%TranslationVel + t(3)*u2%TurbineComponents%Hub%TranslationVel - t(2)*u3%TurbineComponents%Hub%TranslationVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%Hub%TranslationVel = u1%TurbineComponents%Hub%TranslationVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Hub%RotationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Hub%RotationVel,1))) - b1 = (t(3)**2*(u1%TurbineComponents%Hub%RotationVel - u2%TurbineComponents%Hub%RotationVel) + t(2)**2*(-u1%TurbineComponents%Hub%RotationVel + u3%TurbineComponents%Hub%RotationVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%Hub%RotationVel + t(3)*u2%TurbineComponents%Hub%RotationVel - t(2)*u3%TurbineComponents%Hub%RotationVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%Hub%RotationVel = u1%TurbineComponents%Hub%RotationVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%RotorFurl%Position,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%RotorFurl%Position,1))) - b1 = (t(3)**2*(u1%TurbineComponents%RotorFurl%Position - u2%TurbineComponents%RotorFurl%Position) + t(2)**2*(-u1%TurbineComponents%RotorFurl%Position + u3%TurbineComponents%RotorFurl%Position))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%RotorFurl%Position + t(3)*u2%TurbineComponents%RotorFurl%Position - t(2)*u3%TurbineComponents%RotorFurl%Position ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%RotorFurl%Position = u1%TurbineComponents%RotorFurl%Position + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b2(SIZE(u_out%TurbineComponents%RotorFurl%Orientation,1),SIZE(u_out%TurbineComponents%RotorFurl%Orientation,2) )) - ALLOCATE(c2(SIZE(u_out%TurbineComponents%RotorFurl%Orientation,1),SIZE(u_out%TurbineComponents%RotorFurl%Orientation,2) )) - b2 = (t(3)**2*(u1%TurbineComponents%RotorFurl%Orientation - u2%TurbineComponents%RotorFurl%Orientation) + t(2)**2*(-u1%TurbineComponents%RotorFurl%Orientation + u3%TurbineComponents%RotorFurl%Orientation))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%TurbineComponents%RotorFurl%Orientation + t(3)*u2%TurbineComponents%RotorFurl%Orientation - t(2)*u3%TurbineComponents%RotorFurl%Orientation ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%RotorFurl%Orientation = u1%TurbineComponents%RotorFurl%Orientation + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%RotorFurl%TranslationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%RotorFurl%TranslationVel,1))) - b1 = (t(3)**2*(u1%TurbineComponents%RotorFurl%TranslationVel - u2%TurbineComponents%RotorFurl%TranslationVel) + t(2)**2*(-u1%TurbineComponents%RotorFurl%TranslationVel + u3%TurbineComponents%RotorFurl%TranslationVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%RotorFurl%TranslationVel + t(3)*u2%TurbineComponents%RotorFurl%TranslationVel - t(2)*u3%TurbineComponents%RotorFurl%TranslationVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%RotorFurl%TranslationVel = u1%TurbineComponents%RotorFurl%TranslationVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%RotorFurl%RotationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%RotorFurl%RotationVel,1))) - b1 = (t(3)**2*(u1%TurbineComponents%RotorFurl%RotationVel - u2%TurbineComponents%RotorFurl%RotationVel) + t(2)**2*(-u1%TurbineComponents%RotorFurl%RotationVel + u3%TurbineComponents%RotorFurl%RotationVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%RotorFurl%RotationVel + t(3)*u2%TurbineComponents%RotorFurl%RotationVel - t(2)*u3%TurbineComponents%RotorFurl%RotationVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%RotorFurl%RotationVel = u1%TurbineComponents%RotorFurl%RotationVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Nacelle%Position,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Nacelle%Position,1))) - b1 = (t(3)**2*(u1%TurbineComponents%Nacelle%Position - u2%TurbineComponents%Nacelle%Position) + t(2)**2*(-u1%TurbineComponents%Nacelle%Position + u3%TurbineComponents%Nacelle%Position))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%Nacelle%Position + t(3)*u2%TurbineComponents%Nacelle%Position - t(2)*u3%TurbineComponents%Nacelle%Position ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%Nacelle%Position = u1%TurbineComponents%Nacelle%Position + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b2(SIZE(u_out%TurbineComponents%Nacelle%Orientation,1),SIZE(u_out%TurbineComponents%Nacelle%Orientation,2) )) - ALLOCATE(c2(SIZE(u_out%TurbineComponents%Nacelle%Orientation,1),SIZE(u_out%TurbineComponents%Nacelle%Orientation,2) )) - b2 = (t(3)**2*(u1%TurbineComponents%Nacelle%Orientation - u2%TurbineComponents%Nacelle%Orientation) + t(2)**2*(-u1%TurbineComponents%Nacelle%Orientation + u3%TurbineComponents%Nacelle%Orientation))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%TurbineComponents%Nacelle%Orientation + t(3)*u2%TurbineComponents%Nacelle%Orientation - t(2)*u3%TurbineComponents%Nacelle%Orientation ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%Nacelle%Orientation = u1%TurbineComponents%Nacelle%Orientation + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Nacelle%TranslationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Nacelle%TranslationVel,1))) - b1 = (t(3)**2*(u1%TurbineComponents%Nacelle%TranslationVel - u2%TurbineComponents%Nacelle%TranslationVel) + t(2)**2*(-u1%TurbineComponents%Nacelle%TranslationVel + u3%TurbineComponents%Nacelle%TranslationVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%Nacelle%TranslationVel + t(3)*u2%TurbineComponents%Nacelle%TranslationVel - t(2)*u3%TurbineComponents%Nacelle%TranslationVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%Nacelle%TranslationVel = u1%TurbineComponents%Nacelle%TranslationVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Nacelle%RotationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Nacelle%RotationVel,1))) - b1 = (t(3)**2*(u1%TurbineComponents%Nacelle%RotationVel - u2%TurbineComponents%Nacelle%RotationVel) + t(2)**2*(-u1%TurbineComponents%Nacelle%RotationVel + u3%TurbineComponents%Nacelle%RotationVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%Nacelle%RotationVel + t(3)*u2%TurbineComponents%Nacelle%RotationVel - t(2)*u3%TurbineComponents%Nacelle%RotationVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%Nacelle%RotationVel = u1%TurbineComponents%Nacelle%RotationVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%TailFin%Position,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%TailFin%Position,1))) - b1 = (t(3)**2*(u1%TurbineComponents%TailFin%Position - u2%TurbineComponents%TailFin%Position) + t(2)**2*(-u1%TurbineComponents%TailFin%Position + u3%TurbineComponents%TailFin%Position))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%TailFin%Position + t(3)*u2%TurbineComponents%TailFin%Position - t(2)*u3%TurbineComponents%TailFin%Position ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%TailFin%Position = u1%TurbineComponents%TailFin%Position + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b2(SIZE(u_out%TurbineComponents%TailFin%Orientation,1),SIZE(u_out%TurbineComponents%TailFin%Orientation,2) )) - ALLOCATE(c2(SIZE(u_out%TurbineComponents%TailFin%Orientation,1),SIZE(u_out%TurbineComponents%TailFin%Orientation,2) )) - b2 = (t(3)**2*(u1%TurbineComponents%TailFin%Orientation - u2%TurbineComponents%TailFin%Orientation) + t(2)**2*(-u1%TurbineComponents%TailFin%Orientation + u3%TurbineComponents%TailFin%Orientation))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%TurbineComponents%TailFin%Orientation + t(3)*u2%TurbineComponents%TailFin%Orientation - t(2)*u3%TurbineComponents%TailFin%Orientation ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%TailFin%Orientation = u1%TurbineComponents%TailFin%Orientation + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%TailFin%TranslationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%TailFin%TranslationVel,1))) - b1 = (t(3)**2*(u1%TurbineComponents%TailFin%TranslationVel - u2%TurbineComponents%TailFin%TranslationVel) + t(2)**2*(-u1%TurbineComponents%TailFin%TranslationVel + u3%TurbineComponents%TailFin%TranslationVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%TailFin%TranslationVel + t(3)*u2%TurbineComponents%TailFin%TranslationVel - t(2)*u3%TurbineComponents%TailFin%TranslationVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%TailFin%TranslationVel = u1%TurbineComponents%TailFin%TranslationVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%TailFin%RotationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%TailFin%RotationVel,1))) - b1 = (t(3)**2*(u1%TurbineComponents%TailFin%RotationVel - u2%TurbineComponents%TailFin%RotationVel) + t(2)**2*(-u1%TurbineComponents%TailFin%RotationVel + u3%TurbineComponents%TailFin%RotationVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%TailFin%RotationVel + t(3)*u2%TurbineComponents%TailFin%RotationVel - t(2)*u3%TurbineComponents%TailFin%RotationVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%TailFin%RotationVel = u1%TurbineComponents%TailFin%RotationVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Tower%Position,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Tower%Position,1))) - b1 = (t(3)**2*(u1%TurbineComponents%Tower%Position - u2%TurbineComponents%Tower%Position) + t(2)**2*(-u1%TurbineComponents%Tower%Position + u3%TurbineComponents%Tower%Position))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%Tower%Position + t(3)*u2%TurbineComponents%Tower%Position - t(2)*u3%TurbineComponents%Tower%Position ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%Tower%Position = u1%TurbineComponents%Tower%Position + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b2(SIZE(u_out%TurbineComponents%Tower%Orientation,1),SIZE(u_out%TurbineComponents%Tower%Orientation,2) )) - ALLOCATE(c2(SIZE(u_out%TurbineComponents%Tower%Orientation,1),SIZE(u_out%TurbineComponents%Tower%Orientation,2) )) - b2 = (t(3)**2*(u1%TurbineComponents%Tower%Orientation - u2%TurbineComponents%Tower%Orientation) + t(2)**2*(-u1%TurbineComponents%Tower%Orientation + u3%TurbineComponents%Tower%Orientation))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%TurbineComponents%Tower%Orientation + t(3)*u2%TurbineComponents%Tower%Orientation - t(2)*u3%TurbineComponents%Tower%Orientation ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%Tower%Orientation = u1%TurbineComponents%Tower%Orientation + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Tower%TranslationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Tower%TranslationVel,1))) - b1 = (t(3)**2*(u1%TurbineComponents%Tower%TranslationVel - u2%TurbineComponents%Tower%TranslationVel) + t(2)**2*(-u1%TurbineComponents%Tower%TranslationVel + u3%TurbineComponents%Tower%TranslationVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%Tower%TranslationVel + t(3)*u2%TurbineComponents%Tower%TranslationVel - t(2)*u3%TurbineComponents%Tower%TranslationVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%Tower%TranslationVel = u1%TurbineComponents%Tower%TranslationVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Tower%RotationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Tower%RotationVel,1))) - b1 = (t(3)**2*(u1%TurbineComponents%Tower%RotationVel - u2%TurbineComponents%Tower%RotationVel) + t(2)**2*(-u1%TurbineComponents%Tower%RotationVel + u3%TurbineComponents%Tower%RotationVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%Tower%RotationVel + t(3)*u2%TurbineComponents%Tower%RotationVel - t(2)*u3%TurbineComponents%Tower%RotationVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%Tower%RotationVel = u1%TurbineComponents%Tower%RotationVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%SubStructure%Position,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%SubStructure%Position,1))) - b1 = (t(3)**2*(u1%TurbineComponents%SubStructure%Position - u2%TurbineComponents%SubStructure%Position) + t(2)**2*(-u1%TurbineComponents%SubStructure%Position + u3%TurbineComponents%SubStructure%Position))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%SubStructure%Position + t(3)*u2%TurbineComponents%SubStructure%Position - t(2)*u3%TurbineComponents%SubStructure%Position ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%SubStructure%Position = u1%TurbineComponents%SubStructure%Position + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b2(SIZE(u_out%TurbineComponents%SubStructure%Orientation,1),SIZE(u_out%TurbineComponents%SubStructure%Orientation,2) )) - ALLOCATE(c2(SIZE(u_out%TurbineComponents%SubStructure%Orientation,1),SIZE(u_out%TurbineComponents%SubStructure%Orientation,2) )) - b2 = (t(3)**2*(u1%TurbineComponents%SubStructure%Orientation - u2%TurbineComponents%SubStructure%Orientation) + t(2)**2*(-u1%TurbineComponents%SubStructure%Orientation + u3%TurbineComponents%SubStructure%Orientation))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%TurbineComponents%SubStructure%Orientation + t(3)*u2%TurbineComponents%SubStructure%Orientation - t(2)*u3%TurbineComponents%SubStructure%Orientation ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%SubStructure%Orientation = u1%TurbineComponents%SubStructure%Orientation + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%SubStructure%TranslationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%SubStructure%TranslationVel,1))) - b1 = (t(3)**2*(u1%TurbineComponents%SubStructure%TranslationVel - u2%TurbineComponents%SubStructure%TranslationVel) + t(2)**2*(-u1%TurbineComponents%SubStructure%TranslationVel + u3%TurbineComponents%SubStructure%TranslationVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%SubStructure%TranslationVel + t(3)*u2%TurbineComponents%SubStructure%TranslationVel - t(2)*u3%TurbineComponents%SubStructure%TranslationVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%SubStructure%TranslationVel = u1%TurbineComponents%SubStructure%TranslationVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%SubStructure%RotationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%SubStructure%RotationVel,1))) - b1 = (t(3)**2*(u1%TurbineComponents%SubStructure%RotationVel - u2%TurbineComponents%SubStructure%RotationVel) + t(2)**2*(-u1%TurbineComponents%SubStructure%RotationVel + u3%TurbineComponents%SubStructure%RotationVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%SubStructure%RotationVel + t(3)*u2%TurbineComponents%SubStructure%RotationVel - t(2)*u3%TurbineComponents%SubStructure%RotationVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%SubStructure%RotationVel = u1%TurbineComponents%SubStructure%RotationVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Foundation%Position,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Foundation%Position,1))) - b1 = (t(3)**2*(u1%TurbineComponents%Foundation%Position - u2%TurbineComponents%Foundation%Position) + t(2)**2*(-u1%TurbineComponents%Foundation%Position + u3%TurbineComponents%Foundation%Position))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%Foundation%Position + t(3)*u2%TurbineComponents%Foundation%Position - t(2)*u3%TurbineComponents%Foundation%Position ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%Foundation%Position = u1%TurbineComponents%Foundation%Position + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b2(SIZE(u_out%TurbineComponents%Foundation%Orientation,1),SIZE(u_out%TurbineComponents%Foundation%Orientation,2) )) - ALLOCATE(c2(SIZE(u_out%TurbineComponents%Foundation%Orientation,1),SIZE(u_out%TurbineComponents%Foundation%Orientation,2) )) - b2 = (t(3)**2*(u1%TurbineComponents%Foundation%Orientation - u2%TurbineComponents%Foundation%Orientation) + t(2)**2*(-u1%TurbineComponents%Foundation%Orientation + u3%TurbineComponents%Foundation%Orientation))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%TurbineComponents%Foundation%Orientation + t(3)*u2%TurbineComponents%Foundation%Orientation - t(2)*u3%TurbineComponents%Foundation%Orientation ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%Foundation%Orientation = u1%TurbineComponents%Foundation%Orientation + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Foundation%TranslationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Foundation%TranslationVel,1))) - b1 = (t(3)**2*(u1%TurbineComponents%Foundation%TranslationVel - u2%TurbineComponents%Foundation%TranslationVel) + t(2)**2*(-u1%TurbineComponents%Foundation%TranslationVel + u3%TurbineComponents%Foundation%TranslationVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%Foundation%TranslationVel + t(3)*u2%TurbineComponents%Foundation%TranslationVel - t(2)*u3%TurbineComponents%Foundation%TranslationVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%Foundation%TranslationVel = u1%TurbineComponents%Foundation%TranslationVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%TurbineComponents%Foundation%RotationVel,1))) - ALLOCATE(c1(SIZE(u_out%TurbineComponents%Foundation%RotationVel,1))) - b1 = (t(3)**2*(u1%TurbineComponents%Foundation%RotationVel - u2%TurbineComponents%Foundation%RotationVel) + t(2)**2*(-u1%TurbineComponents%Foundation%RotationVel + u3%TurbineComponents%Foundation%RotationVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%TurbineComponents%Foundation%RotationVel + t(3)*u2%TurbineComponents%Foundation%RotationVel - t(2)*u3%TurbineComponents%Foundation%RotationVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%Foundation%RotationVel = u1%TurbineComponents%Foundation%RotationVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - b0 = (t(3)**2*(u1%TurbineComponents%BladeLength - u2%TurbineComponents%BladeLength) + t(2)**2*(-u1%TurbineComponents%BladeLength + u3%TurbineComponents%BladeLength))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%TurbineComponents%BladeLength + t(3)*u2%TurbineComponents%BladeLength - t(2)*u3%TurbineComponents%BladeLength ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TurbineComponents%BladeLength = u1%TurbineComponents%BladeLength + b0 * t_out + c0 * t_out**2 + DO i1 = LBOUND(u_out%TurbineComponents%Hub%Position,1),UBOUND(u_out%TurbineComponents%Hub%Position,1) + b = (t(3)**2*(u1%TurbineComponents%Hub%Position(i1) - u2%TurbineComponents%Hub%Position(i1)) + t(2)**2*(-u1%TurbineComponents%Hub%Position(i1) + u3%TurbineComponents%Hub%Position(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%Hub%Position(i1) + t(3)*u2%TurbineComponents%Hub%Position(i1) - t(2)*u3%TurbineComponents%Hub%Position(i1) ) * scaleFactor + u_out%TurbineComponents%Hub%Position(i1) = u1%TurbineComponents%Hub%Position(i1) + b + c * t_out + END DO + DO i2 = LBOUND(u_out%TurbineComponents%Hub%Orientation,2),UBOUND(u_out%TurbineComponents%Hub%Orientation,2) + DO i1 = LBOUND(u_out%TurbineComponents%Hub%Orientation,1),UBOUND(u_out%TurbineComponents%Hub%Orientation,1) + b = (t(3)**2*(u1%TurbineComponents%Hub%Orientation(i1,i2) - u2%TurbineComponents%Hub%Orientation(i1,i2)) + t(2)**2*(-u1%TurbineComponents%Hub%Orientation(i1,i2) + u3%TurbineComponents%Hub%Orientation(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%Hub%Orientation(i1,i2) + t(3)*u2%TurbineComponents%Hub%Orientation(i1,i2) - t(2)*u3%TurbineComponents%Hub%Orientation(i1,i2) ) * scaleFactor + u_out%TurbineComponents%Hub%Orientation(i1,i2) = u1%TurbineComponents%Hub%Orientation(i1,i2) + b + c * t_out + END DO + END DO + DO i1 = LBOUND(u_out%TurbineComponents%Hub%TranslationVel,1),UBOUND(u_out%TurbineComponents%Hub%TranslationVel,1) + b = (t(3)**2*(u1%TurbineComponents%Hub%TranslationVel(i1) - u2%TurbineComponents%Hub%TranslationVel(i1)) + t(2)**2*(-u1%TurbineComponents%Hub%TranslationVel(i1) + u3%TurbineComponents%Hub%TranslationVel(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%Hub%TranslationVel(i1) + t(3)*u2%TurbineComponents%Hub%TranslationVel(i1) - t(2)*u3%TurbineComponents%Hub%TranslationVel(i1) ) * scaleFactor + u_out%TurbineComponents%Hub%TranslationVel(i1) = u1%TurbineComponents%Hub%TranslationVel(i1) + b + c * t_out + END DO + DO i1 = LBOUND(u_out%TurbineComponents%Hub%RotationVel,1),UBOUND(u_out%TurbineComponents%Hub%RotationVel,1) + b = (t(3)**2*(u1%TurbineComponents%Hub%RotationVel(i1) - u2%TurbineComponents%Hub%RotationVel(i1)) + t(2)**2*(-u1%TurbineComponents%Hub%RotationVel(i1) + u3%TurbineComponents%Hub%RotationVel(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%Hub%RotationVel(i1) + t(3)*u2%TurbineComponents%Hub%RotationVel(i1) - t(2)*u3%TurbineComponents%Hub%RotationVel(i1) ) * scaleFactor + u_out%TurbineComponents%Hub%RotationVel(i1) = u1%TurbineComponents%Hub%RotationVel(i1) + b + c * t_out + END DO + DO i1 = LBOUND(u_out%TurbineComponents%RotorFurl%Position,1),UBOUND(u_out%TurbineComponents%RotorFurl%Position,1) + b = (t(3)**2*(u1%TurbineComponents%RotorFurl%Position(i1) - u2%TurbineComponents%RotorFurl%Position(i1)) + t(2)**2*(-u1%TurbineComponents%RotorFurl%Position(i1) + u3%TurbineComponents%RotorFurl%Position(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%RotorFurl%Position(i1) + t(3)*u2%TurbineComponents%RotorFurl%Position(i1) - t(2)*u3%TurbineComponents%RotorFurl%Position(i1) ) * scaleFactor + u_out%TurbineComponents%RotorFurl%Position(i1) = u1%TurbineComponents%RotorFurl%Position(i1) + b + c * t_out + END DO + DO i2 = LBOUND(u_out%TurbineComponents%RotorFurl%Orientation,2),UBOUND(u_out%TurbineComponents%RotorFurl%Orientation,2) + DO i1 = LBOUND(u_out%TurbineComponents%RotorFurl%Orientation,1),UBOUND(u_out%TurbineComponents%RotorFurl%Orientation,1) + b = (t(3)**2*(u1%TurbineComponents%RotorFurl%Orientation(i1,i2) - u2%TurbineComponents%RotorFurl%Orientation(i1,i2)) + t(2)**2*(-u1%TurbineComponents%RotorFurl%Orientation(i1,i2) + u3%TurbineComponents%RotorFurl%Orientation(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%RotorFurl%Orientation(i1,i2) + t(3)*u2%TurbineComponents%RotorFurl%Orientation(i1,i2) - t(2)*u3%TurbineComponents%RotorFurl%Orientation(i1,i2) ) * scaleFactor + u_out%TurbineComponents%RotorFurl%Orientation(i1,i2) = u1%TurbineComponents%RotorFurl%Orientation(i1,i2) + b + c * t_out + END DO + END DO + DO i1 = LBOUND(u_out%TurbineComponents%RotorFurl%TranslationVel,1),UBOUND(u_out%TurbineComponents%RotorFurl%TranslationVel,1) + b = (t(3)**2*(u1%TurbineComponents%RotorFurl%TranslationVel(i1) - u2%TurbineComponents%RotorFurl%TranslationVel(i1)) + t(2)**2*(-u1%TurbineComponents%RotorFurl%TranslationVel(i1) + u3%TurbineComponents%RotorFurl%TranslationVel(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%RotorFurl%TranslationVel(i1) + t(3)*u2%TurbineComponents%RotorFurl%TranslationVel(i1) - t(2)*u3%TurbineComponents%RotorFurl%TranslationVel(i1) ) * scaleFactor + u_out%TurbineComponents%RotorFurl%TranslationVel(i1) = u1%TurbineComponents%RotorFurl%TranslationVel(i1) + b + c * t_out + END DO + DO i1 = LBOUND(u_out%TurbineComponents%RotorFurl%RotationVel,1),UBOUND(u_out%TurbineComponents%RotorFurl%RotationVel,1) + b = (t(3)**2*(u1%TurbineComponents%RotorFurl%RotationVel(i1) - u2%TurbineComponents%RotorFurl%RotationVel(i1)) + t(2)**2*(-u1%TurbineComponents%RotorFurl%RotationVel(i1) + u3%TurbineComponents%RotorFurl%RotationVel(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%RotorFurl%RotationVel(i1) + t(3)*u2%TurbineComponents%RotorFurl%RotationVel(i1) - t(2)*u3%TurbineComponents%RotorFurl%RotationVel(i1) ) * scaleFactor + u_out%TurbineComponents%RotorFurl%RotationVel(i1) = u1%TurbineComponents%RotorFurl%RotationVel(i1) + b + c * t_out + END DO + DO i1 = LBOUND(u_out%TurbineComponents%Nacelle%Position,1),UBOUND(u_out%TurbineComponents%Nacelle%Position,1) + b = (t(3)**2*(u1%TurbineComponents%Nacelle%Position(i1) - u2%TurbineComponents%Nacelle%Position(i1)) + t(2)**2*(-u1%TurbineComponents%Nacelle%Position(i1) + u3%TurbineComponents%Nacelle%Position(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%Nacelle%Position(i1) + t(3)*u2%TurbineComponents%Nacelle%Position(i1) - t(2)*u3%TurbineComponents%Nacelle%Position(i1) ) * scaleFactor + u_out%TurbineComponents%Nacelle%Position(i1) = u1%TurbineComponents%Nacelle%Position(i1) + b + c * t_out + END DO + DO i2 = LBOUND(u_out%TurbineComponents%Nacelle%Orientation,2),UBOUND(u_out%TurbineComponents%Nacelle%Orientation,2) + DO i1 = LBOUND(u_out%TurbineComponents%Nacelle%Orientation,1),UBOUND(u_out%TurbineComponents%Nacelle%Orientation,1) + b = (t(3)**2*(u1%TurbineComponents%Nacelle%Orientation(i1,i2) - u2%TurbineComponents%Nacelle%Orientation(i1,i2)) + t(2)**2*(-u1%TurbineComponents%Nacelle%Orientation(i1,i2) + u3%TurbineComponents%Nacelle%Orientation(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%Nacelle%Orientation(i1,i2) + t(3)*u2%TurbineComponents%Nacelle%Orientation(i1,i2) - t(2)*u3%TurbineComponents%Nacelle%Orientation(i1,i2) ) * scaleFactor + u_out%TurbineComponents%Nacelle%Orientation(i1,i2) = u1%TurbineComponents%Nacelle%Orientation(i1,i2) + b + c * t_out + END DO + END DO + DO i1 = LBOUND(u_out%TurbineComponents%Nacelle%TranslationVel,1),UBOUND(u_out%TurbineComponents%Nacelle%TranslationVel,1) + b = (t(3)**2*(u1%TurbineComponents%Nacelle%TranslationVel(i1) - u2%TurbineComponents%Nacelle%TranslationVel(i1)) + t(2)**2*(-u1%TurbineComponents%Nacelle%TranslationVel(i1) + u3%TurbineComponents%Nacelle%TranslationVel(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%Nacelle%TranslationVel(i1) + t(3)*u2%TurbineComponents%Nacelle%TranslationVel(i1) - t(2)*u3%TurbineComponents%Nacelle%TranslationVel(i1) ) * scaleFactor + u_out%TurbineComponents%Nacelle%TranslationVel(i1) = u1%TurbineComponents%Nacelle%TranslationVel(i1) + b + c * t_out + END DO + DO i1 = LBOUND(u_out%TurbineComponents%Nacelle%RotationVel,1),UBOUND(u_out%TurbineComponents%Nacelle%RotationVel,1) + b = (t(3)**2*(u1%TurbineComponents%Nacelle%RotationVel(i1) - u2%TurbineComponents%Nacelle%RotationVel(i1)) + t(2)**2*(-u1%TurbineComponents%Nacelle%RotationVel(i1) + u3%TurbineComponents%Nacelle%RotationVel(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%Nacelle%RotationVel(i1) + t(3)*u2%TurbineComponents%Nacelle%RotationVel(i1) - t(2)*u3%TurbineComponents%Nacelle%RotationVel(i1) ) * scaleFactor + u_out%TurbineComponents%Nacelle%RotationVel(i1) = u1%TurbineComponents%Nacelle%RotationVel(i1) + b + c * t_out + END DO + DO i1 = LBOUND(u_out%TurbineComponents%TailFin%Position,1),UBOUND(u_out%TurbineComponents%TailFin%Position,1) + b = (t(3)**2*(u1%TurbineComponents%TailFin%Position(i1) - u2%TurbineComponents%TailFin%Position(i1)) + t(2)**2*(-u1%TurbineComponents%TailFin%Position(i1) + u3%TurbineComponents%TailFin%Position(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%TailFin%Position(i1) + t(3)*u2%TurbineComponents%TailFin%Position(i1) - t(2)*u3%TurbineComponents%TailFin%Position(i1) ) * scaleFactor + u_out%TurbineComponents%TailFin%Position(i1) = u1%TurbineComponents%TailFin%Position(i1) + b + c * t_out + END DO + DO i2 = LBOUND(u_out%TurbineComponents%TailFin%Orientation,2),UBOUND(u_out%TurbineComponents%TailFin%Orientation,2) + DO i1 = LBOUND(u_out%TurbineComponents%TailFin%Orientation,1),UBOUND(u_out%TurbineComponents%TailFin%Orientation,1) + b = (t(3)**2*(u1%TurbineComponents%TailFin%Orientation(i1,i2) - u2%TurbineComponents%TailFin%Orientation(i1,i2)) + t(2)**2*(-u1%TurbineComponents%TailFin%Orientation(i1,i2) + u3%TurbineComponents%TailFin%Orientation(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%TailFin%Orientation(i1,i2) + t(3)*u2%TurbineComponents%TailFin%Orientation(i1,i2) - t(2)*u3%TurbineComponents%TailFin%Orientation(i1,i2) ) * scaleFactor + u_out%TurbineComponents%TailFin%Orientation(i1,i2) = u1%TurbineComponents%TailFin%Orientation(i1,i2) + b + c * t_out + END DO + END DO + DO i1 = LBOUND(u_out%TurbineComponents%TailFin%TranslationVel,1),UBOUND(u_out%TurbineComponents%TailFin%TranslationVel,1) + b = (t(3)**2*(u1%TurbineComponents%TailFin%TranslationVel(i1) - u2%TurbineComponents%TailFin%TranslationVel(i1)) + t(2)**2*(-u1%TurbineComponents%TailFin%TranslationVel(i1) + u3%TurbineComponents%TailFin%TranslationVel(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%TailFin%TranslationVel(i1) + t(3)*u2%TurbineComponents%TailFin%TranslationVel(i1) - t(2)*u3%TurbineComponents%TailFin%TranslationVel(i1) ) * scaleFactor + u_out%TurbineComponents%TailFin%TranslationVel(i1) = u1%TurbineComponents%TailFin%TranslationVel(i1) + b + c * t_out + END DO + DO i1 = LBOUND(u_out%TurbineComponents%TailFin%RotationVel,1),UBOUND(u_out%TurbineComponents%TailFin%RotationVel,1) + b = (t(3)**2*(u1%TurbineComponents%TailFin%RotationVel(i1) - u2%TurbineComponents%TailFin%RotationVel(i1)) + t(2)**2*(-u1%TurbineComponents%TailFin%RotationVel(i1) + u3%TurbineComponents%TailFin%RotationVel(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%TailFin%RotationVel(i1) + t(3)*u2%TurbineComponents%TailFin%RotationVel(i1) - t(2)*u3%TurbineComponents%TailFin%RotationVel(i1) ) * scaleFactor + u_out%TurbineComponents%TailFin%RotationVel(i1) = u1%TurbineComponents%TailFin%RotationVel(i1) + b + c * t_out + END DO + DO i1 = LBOUND(u_out%TurbineComponents%Tower%Position,1),UBOUND(u_out%TurbineComponents%Tower%Position,1) + b = (t(3)**2*(u1%TurbineComponents%Tower%Position(i1) - u2%TurbineComponents%Tower%Position(i1)) + t(2)**2*(-u1%TurbineComponents%Tower%Position(i1) + u3%TurbineComponents%Tower%Position(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%Tower%Position(i1) + t(3)*u2%TurbineComponents%Tower%Position(i1) - t(2)*u3%TurbineComponents%Tower%Position(i1) ) * scaleFactor + u_out%TurbineComponents%Tower%Position(i1) = u1%TurbineComponents%Tower%Position(i1) + b + c * t_out + END DO + DO i2 = LBOUND(u_out%TurbineComponents%Tower%Orientation,2),UBOUND(u_out%TurbineComponents%Tower%Orientation,2) + DO i1 = LBOUND(u_out%TurbineComponents%Tower%Orientation,1),UBOUND(u_out%TurbineComponents%Tower%Orientation,1) + b = (t(3)**2*(u1%TurbineComponents%Tower%Orientation(i1,i2) - u2%TurbineComponents%Tower%Orientation(i1,i2)) + t(2)**2*(-u1%TurbineComponents%Tower%Orientation(i1,i2) + u3%TurbineComponents%Tower%Orientation(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%Tower%Orientation(i1,i2) + t(3)*u2%TurbineComponents%Tower%Orientation(i1,i2) - t(2)*u3%TurbineComponents%Tower%Orientation(i1,i2) ) * scaleFactor + u_out%TurbineComponents%Tower%Orientation(i1,i2) = u1%TurbineComponents%Tower%Orientation(i1,i2) + b + c * t_out + END DO + END DO + DO i1 = LBOUND(u_out%TurbineComponents%Tower%TranslationVel,1),UBOUND(u_out%TurbineComponents%Tower%TranslationVel,1) + b = (t(3)**2*(u1%TurbineComponents%Tower%TranslationVel(i1) - u2%TurbineComponents%Tower%TranslationVel(i1)) + t(2)**2*(-u1%TurbineComponents%Tower%TranslationVel(i1) + u3%TurbineComponents%Tower%TranslationVel(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%Tower%TranslationVel(i1) + t(3)*u2%TurbineComponents%Tower%TranslationVel(i1) - t(2)*u3%TurbineComponents%Tower%TranslationVel(i1) ) * scaleFactor + u_out%TurbineComponents%Tower%TranslationVel(i1) = u1%TurbineComponents%Tower%TranslationVel(i1) + b + c * t_out + END DO + DO i1 = LBOUND(u_out%TurbineComponents%Tower%RotationVel,1),UBOUND(u_out%TurbineComponents%Tower%RotationVel,1) + b = (t(3)**2*(u1%TurbineComponents%Tower%RotationVel(i1) - u2%TurbineComponents%Tower%RotationVel(i1)) + t(2)**2*(-u1%TurbineComponents%Tower%RotationVel(i1) + u3%TurbineComponents%Tower%RotationVel(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%Tower%RotationVel(i1) + t(3)*u2%TurbineComponents%Tower%RotationVel(i1) - t(2)*u3%TurbineComponents%Tower%RotationVel(i1) ) * scaleFactor + u_out%TurbineComponents%Tower%RotationVel(i1) = u1%TurbineComponents%Tower%RotationVel(i1) + b + c * t_out + END DO + DO i1 = LBOUND(u_out%TurbineComponents%SubStructure%Position,1),UBOUND(u_out%TurbineComponents%SubStructure%Position,1) + b = (t(3)**2*(u1%TurbineComponents%SubStructure%Position(i1) - u2%TurbineComponents%SubStructure%Position(i1)) + t(2)**2*(-u1%TurbineComponents%SubStructure%Position(i1) + u3%TurbineComponents%SubStructure%Position(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%SubStructure%Position(i1) + t(3)*u2%TurbineComponents%SubStructure%Position(i1) - t(2)*u3%TurbineComponents%SubStructure%Position(i1) ) * scaleFactor + u_out%TurbineComponents%SubStructure%Position(i1) = u1%TurbineComponents%SubStructure%Position(i1) + b + c * t_out + END DO + DO i2 = LBOUND(u_out%TurbineComponents%SubStructure%Orientation,2),UBOUND(u_out%TurbineComponents%SubStructure%Orientation,2) + DO i1 = LBOUND(u_out%TurbineComponents%SubStructure%Orientation,1),UBOUND(u_out%TurbineComponents%SubStructure%Orientation,1) + b = (t(3)**2*(u1%TurbineComponents%SubStructure%Orientation(i1,i2) - u2%TurbineComponents%SubStructure%Orientation(i1,i2)) + t(2)**2*(-u1%TurbineComponents%SubStructure%Orientation(i1,i2) + u3%TurbineComponents%SubStructure%Orientation(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%SubStructure%Orientation(i1,i2) + t(3)*u2%TurbineComponents%SubStructure%Orientation(i1,i2) - t(2)*u3%TurbineComponents%SubStructure%Orientation(i1,i2) ) * scaleFactor + u_out%TurbineComponents%SubStructure%Orientation(i1,i2) = u1%TurbineComponents%SubStructure%Orientation(i1,i2) + b + c * t_out + END DO + END DO + DO i1 = LBOUND(u_out%TurbineComponents%SubStructure%TranslationVel,1),UBOUND(u_out%TurbineComponents%SubStructure%TranslationVel,1) + b = (t(3)**2*(u1%TurbineComponents%SubStructure%TranslationVel(i1) - u2%TurbineComponents%SubStructure%TranslationVel(i1)) + t(2)**2*(-u1%TurbineComponents%SubStructure%TranslationVel(i1) + u3%TurbineComponents%SubStructure%TranslationVel(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%SubStructure%TranslationVel(i1) + t(3)*u2%TurbineComponents%SubStructure%TranslationVel(i1) - t(2)*u3%TurbineComponents%SubStructure%TranslationVel(i1) ) * scaleFactor + u_out%TurbineComponents%SubStructure%TranslationVel(i1) = u1%TurbineComponents%SubStructure%TranslationVel(i1) + b + c * t_out + END DO + DO i1 = LBOUND(u_out%TurbineComponents%SubStructure%RotationVel,1),UBOUND(u_out%TurbineComponents%SubStructure%RotationVel,1) + b = (t(3)**2*(u1%TurbineComponents%SubStructure%RotationVel(i1) - u2%TurbineComponents%SubStructure%RotationVel(i1)) + t(2)**2*(-u1%TurbineComponents%SubStructure%RotationVel(i1) + u3%TurbineComponents%SubStructure%RotationVel(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%SubStructure%RotationVel(i1) + t(3)*u2%TurbineComponents%SubStructure%RotationVel(i1) - t(2)*u3%TurbineComponents%SubStructure%RotationVel(i1) ) * scaleFactor + u_out%TurbineComponents%SubStructure%RotationVel(i1) = u1%TurbineComponents%SubStructure%RotationVel(i1) + b + c * t_out + END DO + DO i1 = LBOUND(u_out%TurbineComponents%Foundation%Position,1),UBOUND(u_out%TurbineComponents%Foundation%Position,1) + b = (t(3)**2*(u1%TurbineComponents%Foundation%Position(i1) - u2%TurbineComponents%Foundation%Position(i1)) + t(2)**2*(-u1%TurbineComponents%Foundation%Position(i1) + u3%TurbineComponents%Foundation%Position(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%Foundation%Position(i1) + t(3)*u2%TurbineComponents%Foundation%Position(i1) - t(2)*u3%TurbineComponents%Foundation%Position(i1) ) * scaleFactor + u_out%TurbineComponents%Foundation%Position(i1) = u1%TurbineComponents%Foundation%Position(i1) + b + c * t_out + END DO + DO i2 = LBOUND(u_out%TurbineComponents%Foundation%Orientation,2),UBOUND(u_out%TurbineComponents%Foundation%Orientation,2) + DO i1 = LBOUND(u_out%TurbineComponents%Foundation%Orientation,1),UBOUND(u_out%TurbineComponents%Foundation%Orientation,1) + b = (t(3)**2*(u1%TurbineComponents%Foundation%Orientation(i1,i2) - u2%TurbineComponents%Foundation%Orientation(i1,i2)) + t(2)**2*(-u1%TurbineComponents%Foundation%Orientation(i1,i2) + u3%TurbineComponents%Foundation%Orientation(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%Foundation%Orientation(i1,i2) + t(3)*u2%TurbineComponents%Foundation%Orientation(i1,i2) - t(2)*u3%TurbineComponents%Foundation%Orientation(i1,i2) ) * scaleFactor + u_out%TurbineComponents%Foundation%Orientation(i1,i2) = u1%TurbineComponents%Foundation%Orientation(i1,i2) + b + c * t_out + END DO + END DO + DO i1 = LBOUND(u_out%TurbineComponents%Foundation%TranslationVel,1),UBOUND(u_out%TurbineComponents%Foundation%TranslationVel,1) + b = (t(3)**2*(u1%TurbineComponents%Foundation%TranslationVel(i1) - u2%TurbineComponents%Foundation%TranslationVel(i1)) + t(2)**2*(-u1%TurbineComponents%Foundation%TranslationVel(i1) + u3%TurbineComponents%Foundation%TranslationVel(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%Foundation%TranslationVel(i1) + t(3)*u2%TurbineComponents%Foundation%TranslationVel(i1) - t(2)*u3%TurbineComponents%Foundation%TranslationVel(i1) ) * scaleFactor + u_out%TurbineComponents%Foundation%TranslationVel(i1) = u1%TurbineComponents%Foundation%TranslationVel(i1) + b + c * t_out + END DO + DO i1 = LBOUND(u_out%TurbineComponents%Foundation%RotationVel,1),UBOUND(u_out%TurbineComponents%Foundation%RotationVel,1) + b = (t(3)**2*(u1%TurbineComponents%Foundation%RotationVel(i1) - u2%TurbineComponents%Foundation%RotationVel(i1)) + t(2)**2*(-u1%TurbineComponents%Foundation%RotationVel(i1) + u3%TurbineComponents%Foundation%RotationVel(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%Foundation%RotationVel(i1) + t(3)*u2%TurbineComponents%Foundation%RotationVel(i1) - t(2)*u3%TurbineComponents%Foundation%RotationVel(i1) ) * scaleFactor + u_out%TurbineComponents%Foundation%RotationVel(i1) = u1%TurbineComponents%Foundation%RotationVel(i1) + b + c * t_out + END DO + b = (t(3)**2*(u1%TurbineComponents%BladeLength - u2%TurbineComponents%BladeLength) + t(2)**2*(-u1%TurbineComponents%BladeLength + u3%TurbineComponents%BladeLength))* scaleFactor + c = ( (t(2)-t(3))*u1%TurbineComponents%BladeLength + t(3)*u2%TurbineComponents%BladeLength - t(2)*u3%TurbineComponents%BladeLength ) * scaleFactor + u_out%TurbineComponents%BladeLength = u1%TurbineComponents%BladeLength + b + c * t_out IF (ALLOCATED(u_out%MulTabLoc) .AND. ALLOCATED(u1%MulTabLoc)) THEN - ALLOCATE(b2(SIZE(u_out%MulTabLoc,1),SIZE(u_out%MulTabLoc,2) )) - ALLOCATE(c2(SIZE(u_out%MulTabLoc,1),SIZE(u_out%MulTabLoc,2) )) - b2 = (t(3)**2*(u1%MulTabLoc - u2%MulTabLoc) + t(2)**2*(-u1%MulTabLoc + u3%MulTabLoc))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%MulTabLoc + t(3)*u2%MulTabLoc - t(2)*u3%MulTabLoc ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%MulTabLoc = u1%MulTabLoc + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%MulTabLoc,2),UBOUND(u_out%MulTabLoc,2) + DO i1 = LBOUND(u_out%MulTabLoc,1),UBOUND(u_out%MulTabLoc,1) + b = (t(3)**2*(u1%MulTabLoc(i1,i2) - u2%MulTabLoc(i1,i2)) + t(2)**2*(-u1%MulTabLoc(i1,i2) + u3%MulTabLoc(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%MulTabLoc(i1,i2) + t(3)*u2%MulTabLoc(i1,i2) - t(2)*u3%MulTabLoc(i1,i2) ) * scaleFactor + u_out%MulTabLoc(i1,i2) = u1%MulTabLoc(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated IF (ALLOCATED(u_out%InflowVelocity) .AND. ALLOCATED(u1%InflowVelocity)) THEN - ALLOCATE(b2(SIZE(u_out%InflowVelocity,1),SIZE(u_out%InflowVelocity,2) )) - ALLOCATE(c2(SIZE(u_out%InflowVelocity,1),SIZE(u_out%InflowVelocity,2) )) - b2 = (t(3)**2*(u1%InflowVelocity - u2%InflowVelocity) + t(2)**2*(-u1%InflowVelocity + u3%InflowVelocity))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%InflowVelocity + t(3)*u2%InflowVelocity - t(2)*u3%InflowVelocity ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%InflowVelocity = u1%InflowVelocity + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%InflowVelocity,2),UBOUND(u_out%InflowVelocity,2) + DO i1 = LBOUND(u_out%InflowVelocity,1),UBOUND(u_out%InflowVelocity,1) + b = (t(3)**2*(u1%InflowVelocity(i1,i2) - u2%InflowVelocity(i1,i2)) + t(2)**2*(-u1%InflowVelocity(i1,i2) + u3%InflowVelocity(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%InflowVelocity(i1,i2) + t(3)*u2%InflowVelocity(i1,i2) - t(2)*u3%InflowVelocity(i1,i2) ) * scaleFactor + u_out%InflowVelocity(i1,i2) = u1%InflowVelocity(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated - ALLOCATE(b1(SIZE(u_out%AvgInfVel,1))) - ALLOCATE(c1(SIZE(u_out%AvgInfVel,1))) - b1 = (t(3)**2*(u1%AvgInfVel - u2%AvgInfVel) + t(2)**2*(-u1%AvgInfVel + u3%AvgInfVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%AvgInfVel + t(3)*u2%AvgInfVel - t(2)*u3%AvgInfVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%AvgInfVel = u1%AvgInfVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%AvgInfVel,1),UBOUND(u_out%AvgInfVel,1) + b = (t(3)**2*(u1%AvgInfVel(i1) - u2%AvgInfVel(i1)) + t(2)**2*(-u1%AvgInfVel(i1) + u3%AvgInfVel(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%AvgInfVel(i1) + t(3)*u2%AvgInfVel(i1) - t(2)*u3%AvgInfVel(i1) ) * scaleFactor + u_out%AvgInfVel(i1) = u1%AvgInfVel(i1) + b + c * t_out + END DO END SUBROUTINE AD14_Input_ExtrapInterp2 @@ -16993,11 +16687,12 @@ SUBROUTINE AD14_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'AD14_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -17010,9 +16705,11 @@ SUBROUTINE AD14_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) IF (ALLOCATED(y_out%OutputLoads) .AND. ALLOCATED(y1%OutputLoads)) THEN - DO i01 = LBOUND(y_out%OutputLoads,1),UBOUND(y_out%OutputLoads,1) - CALL MeshExtrapInterp1(y1%OutputLoads(i01), y2%OutputLoads(i01), tin, y_out%OutputLoads(i01), tin_out, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(y_out%OutputLoads,1),UBOUND(y_out%OutputLoads,1) + CALL MeshExtrapInterp1(y1%OutputLoads(i1), y2%OutputLoads(i1), tin, y_out%OutputLoads(i1), tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) ENDDO END IF ! check if allocated @@ -17047,12 +16744,14 @@ SUBROUTINE AD14_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'AD14_Output_ExtrapInterp2' INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -17071,9 +16770,11 @@ SUBROUTINE AD14_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) IF (ALLOCATED(y_out%OutputLoads) .AND. ALLOCATED(y1%OutputLoads)) THEN - DO i01 = LBOUND(y_out%OutputLoads,1),UBOUND(y_out%OutputLoads,1) - CALL MeshExtrapInterp2(y1%OutputLoads(i01), y2%OutputLoads(i01), y3%OutputLoads(i01), tin, y_out%OutputLoads(i01), tin_out, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(y_out%OutputLoads,1),UBOUND(y_out%OutputLoads,1) + CALL MeshExtrapInterp2(y1%OutputLoads(i1), y2%OutputLoads(i1), y3%OutputLoads(i1), tin, y_out%OutputLoads(i1), tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) ENDDO END IF ! check if allocated diff --git a/modules/aerodyn14/src/DWM_Types.f90 b/modules/aerodyn14/src/DWM_Types.f90 index f18608cc83..0678240e6c 100644 --- a/modules/aerodyn14/src/DWM_Types.f90 +++ b/modules/aerodyn14/src/DWM_Types.f90 @@ -432,12 +432,12 @@ SUBROUTINE DWM_PackCVSD( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%counter - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Denominator - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Numerator - Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%counter + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Denominator + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Numerator + Re_Xferred = Re_Xferred + 1 END SUBROUTINE DWM_PackCVSD SUBROUTINE DWM_UnPackCVSD( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -453,12 +453,6 @@ SUBROUTINE DWM_UnPackCVSD( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (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 @@ -476,12 +470,12 @@ SUBROUTINE DWM_UnPackCVSD( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%counter = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%Denominator = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Numerator = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%counter = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%Denominator = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Numerator = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE DWM_UnPackCVSD SUBROUTINE DWM_Copyturbine_average_velocity_data( Srcturbine_average_velocity_dataData, Dstturbine_average_velocity_dataData, CtrlCode, ErrStat, ErrMsg ) @@ -670,8 +664,10 @@ SUBROUTINE DWM_Packturbine_average_velocity_data( ReKiBuf, DbKiBuf, IntKiBuf, In IntKiBuf( Int_Xferred + 1) = UBOUND(InData%average_velocity_array_temp,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%average_velocity_array_temp)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%average_velocity_array_temp))-1 ) = PACK(InData%average_velocity_array_temp,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%average_velocity_array_temp) + DO i1 = LBOUND(InData%average_velocity_array_temp,1), UBOUND(InData%average_velocity_array_temp,1) + ReKiBuf(Re_Xferred) = InData%average_velocity_array_temp(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%average_velocity_array) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -683,8 +679,10 @@ SUBROUTINE DWM_Packturbine_average_velocity_data( ReKiBuf, DbKiBuf, IntKiBuf, In IntKiBuf( Int_Xferred + 1) = UBOUND(InData%average_velocity_array,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%average_velocity_array)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%average_velocity_array))-1 ) = PACK(InData%average_velocity_array,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%average_velocity_array) + DO i1 = LBOUND(InData%average_velocity_array,1), UBOUND(InData%average_velocity_array,1) + ReKiBuf(Re_Xferred) = InData%average_velocity_array(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%swept_area) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -696,11 +694,13 @@ SUBROUTINE DWM_Packturbine_average_velocity_data( ReKiBuf, DbKiBuf, IntKiBuf, In IntKiBuf( Int_Xferred + 1) = UBOUND(InData%swept_area,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%swept_area)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%swept_area))-1 ) = PACK(InData%swept_area,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%swept_area) + DO i1 = LBOUND(InData%swept_area,1), UBOUND(InData%swept_area,1) + ReKiBuf(Re_Xferred) = InData%swept_area(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%time_step_velocity - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%time_step_velocity + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%time_step_velocity_array) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -711,13 +711,15 @@ SUBROUTINE DWM_Packturbine_average_velocity_data( ReKiBuf, DbKiBuf, IntKiBuf, In IntKiBuf( Int_Xferred + 1) = UBOUND(InData%time_step_velocity_array,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%time_step_velocity_array)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%time_step_velocity_array))-1 ) = PACK(InData%time_step_velocity_array,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%time_step_velocity_array) + DO i1 = LBOUND(InData%time_step_velocity_array,1), UBOUND(InData%time_step_velocity_array,1) + IntKiBuf(Int_Xferred) = InData%time_step_velocity_array(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%time_step_pass_velocity - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%time_step_force - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%time_step_pass_velocity + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%time_step_force + Int_Xferred = Int_Xferred + 1 END SUBROUTINE DWM_Packturbine_average_velocity_data SUBROUTINE DWM_UnPackturbine_average_velocity_data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -733,12 +735,6 @@ SUBROUTINE DWM_UnPackturbine_average_velocity_data( ReKiBuf, DbKiBuf, IntKiBuf, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -766,15 +762,10 @@ SUBROUTINE DWM_UnPackturbine_average_velocity_data( ReKiBuf, DbKiBuf, IntKiBuf, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%average_velocity_array_temp.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%average_velocity_array_temp)>0) OutData%average_velocity_array_temp = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%average_velocity_array_temp))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%average_velocity_array_temp) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%average_velocity_array_temp,1), UBOUND(OutData%average_velocity_array_temp,1) + OutData%average_velocity_array_temp(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! average_velocity_array not allocated Int_Xferred = Int_Xferred + 1 @@ -789,15 +780,10 @@ SUBROUTINE DWM_UnPackturbine_average_velocity_data( ReKiBuf, DbKiBuf, IntKiBuf, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%average_velocity_array.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%average_velocity_array)>0) OutData%average_velocity_array = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%average_velocity_array))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%average_velocity_array) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%average_velocity_array,1), UBOUND(OutData%average_velocity_array,1) + OutData%average_velocity_array(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! swept_area not allocated Int_Xferred = Int_Xferred + 1 @@ -812,18 +798,13 @@ SUBROUTINE DWM_UnPackturbine_average_velocity_data( ReKiBuf, DbKiBuf, IntKiBuf, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%swept_area.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%swept_area)>0) OutData%swept_area = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%swept_area))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%swept_area) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%swept_area,1), UBOUND(OutData%swept_area,1) + OutData%swept_area(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%time_step_velocity = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%time_step_velocity = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! time_step_velocity_array not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -837,20 +818,15 @@ SUBROUTINE DWM_UnPackturbine_average_velocity_data( ReKiBuf, DbKiBuf, IntKiBuf, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%time_step_velocity_array.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%time_step_velocity_array)>0) OutData%time_step_velocity_array = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%time_step_velocity_array))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%time_step_velocity_array) - DEALLOCATE(mask1) - END IF - OutData%time_step_pass_velocity = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%time_step_force = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%time_step_velocity_array,1), UBOUND(OutData%time_step_velocity_array,1) + OutData%time_step_velocity_array(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + OutData%time_step_pass_velocity = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%time_step_force = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE DWM_UnPackturbine_average_velocity_data SUBROUTINE DWM_CopyWake_Deficit_Data( SrcWake_Deficit_DataData, DstWake_Deficit_DataData, CtrlCode, ErrStat, ErrMsg ) @@ -976,10 +952,10 @@ SUBROUTINE DWM_PackWake_Deficit_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%np_x - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%X_length - Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%np_x + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%X_length + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%Turb_Stress_DWM) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -993,15 +969,19 @@ SUBROUTINE DWM_PackWake_Deficit_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Turb_Stress_DWM,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Turb_Stress_DWM)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Turb_Stress_DWM))-1 ) = PACK(InData%Turb_Stress_DWM,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Turb_Stress_DWM) + DO i2 = LBOUND(InData%Turb_Stress_DWM,2), UBOUND(InData%Turb_Stress_DWM,2) + DO i1 = LBOUND(InData%Turb_Stress_DWM,1), UBOUND(InData%Turb_Stress_DWM,1) + ReKiBuf(Re_Xferred) = InData%Turb_Stress_DWM(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%n_x_vector - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%n_r_vector - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ppR - Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%n_x_vector + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%n_r_vector + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%ppR + Re_Xferred = Re_Xferred + 1 END SUBROUTINE DWM_PackWake_Deficit_Data SUBROUTINE DWM_UnPackWake_Deficit_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1017,12 +997,6 @@ SUBROUTINE DWM_UnPackWake_Deficit_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -1038,10 +1012,10 @@ SUBROUTINE DWM_UnPackWake_Deficit_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%np_x = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%X_length = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%np_x = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%X_length = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Turb_Stress_DWM not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1058,22 +1032,19 @@ SUBROUTINE DWM_UnPackWake_Deficit_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Turb_Stress_DWM.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Turb_Stress_DWM)>0) OutData%Turb_Stress_DWM = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Turb_Stress_DWM))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Turb_Stress_DWM) - DEALLOCATE(mask2) - END IF - OutData%n_x_vector = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%n_r_vector = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%ppR = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(OutData%Turb_Stress_DWM,2), UBOUND(OutData%Turb_Stress_DWM,2) + DO i1 = LBOUND(OutData%Turb_Stress_DWM,1), UBOUND(OutData%Turb_Stress_DWM,1) + OutData%Turb_Stress_DWM(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%n_x_vector = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%n_r_vector = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ppR = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE DWM_UnPackWake_Deficit_Data SUBROUTINE DWM_CopyMeanderData( SrcMeanderDataData, DstMeanderDataData, CtrlCode, ErrStat, ErrMsg ) @@ -1169,10 +1140,10 @@ SUBROUTINE DWM_PackMeanderData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%scale_factor - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%moving_time - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%scale_factor + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%moving_time + Int_Xferred = Int_Xferred + 1 END SUBROUTINE DWM_PackMeanderData SUBROUTINE DWM_UnPackMeanderData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1188,12 +1159,6 @@ SUBROUTINE DWM_UnPackMeanderData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DWM_UnPackMeanderData' @@ -1207,10 +1172,10 @@ SUBROUTINE DWM_UnPackMeanderData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%scale_factor = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%moving_time = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%scale_factor = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%moving_time = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE DWM_UnPackMeanderData SUBROUTINE DWM_Copyread_turbine_position_data( Srcread_turbine_position_dataData, Dstread_turbine_position_dataData, CtrlCode, ErrStat, ErrMsg ) @@ -1636,8 +1601,8 @@ SUBROUTINE DWM_Packread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Indat Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%SimulationOrder_index - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%SimulationOrder_index + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%Turbine_sort_order) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1648,11 +1613,13 @@ SUBROUTINE DWM_Packread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Indat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Turbine_sort_order,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Turbine_sort_order)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%Turbine_sort_order))-1 ) = PACK(InData%Turbine_sort_order,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%Turbine_sort_order) + DO i1 = LBOUND(InData%Turbine_sort_order,1), UBOUND(InData%Turbine_sort_order,1) + IntKiBuf(Int_Xferred) = InData%Turbine_sort_order(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WT_index - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WT_index + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%TurbineInfluenceData) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1666,8 +1633,12 @@ SUBROUTINE DWM_Packread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Indat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TurbineInfluenceData,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TurbineInfluenceData)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%TurbineInfluenceData))-1 ) = PACK(InData%TurbineInfluenceData,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%TurbineInfluenceData) + DO i2 = LBOUND(InData%TurbineInfluenceData,2), UBOUND(InData%TurbineInfluenceData,2) + DO i1 = LBOUND(InData%TurbineInfluenceData,1), UBOUND(InData%TurbineInfluenceData,1) + IntKiBuf(Int_Xferred) = InData%TurbineInfluenceData(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%upwind_turbine_index) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1679,8 +1650,10 @@ SUBROUTINE DWM_Packread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Indat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_turbine_index,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%upwind_turbine_index)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%upwind_turbine_index))-1 ) = PACK(InData%upwind_turbine_index,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%upwind_turbine_index) + DO i1 = LBOUND(InData%upwind_turbine_index,1), UBOUND(InData%upwind_turbine_index,1) + IntKiBuf(Int_Xferred) = InData%upwind_turbine_index(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%downwind_turbine_index) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1692,13 +1665,15 @@ SUBROUTINE DWM_Packread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Indat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%downwind_turbine_index,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%downwind_turbine_index)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%downwind_turbine_index))-1 ) = PACK(InData%downwind_turbine_index,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%downwind_turbine_index) + DO i1 = LBOUND(InData%downwind_turbine_index,1), UBOUND(InData%downwind_turbine_index,1) + IntKiBuf(Int_Xferred) = InData%downwind_turbine_index(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%upwindturbine_number - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%downwindturbine_number - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%upwindturbine_number + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%downwindturbine_number + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%turbine_windorigin_length) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1709,8 +1684,10 @@ SUBROUTINE DWM_Packread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Indat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%turbine_windorigin_length,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%turbine_windorigin_length)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%turbine_windorigin_length))-1 ) = PACK(InData%turbine_windorigin_length,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%turbine_windorigin_length) + DO i1 = LBOUND(InData%turbine_windorigin_length,1), UBOUND(InData%turbine_windorigin_length,1) + ReKiBuf(Re_Xferred) = InData%turbine_windorigin_length(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%upwind_turbine_projected_distance) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1722,8 +1699,10 @@ SUBROUTINE DWM_Packread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Indat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_turbine_projected_distance,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%upwind_turbine_projected_distance)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%upwind_turbine_projected_distance))-1 ) = PACK(InData%upwind_turbine_projected_distance,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%upwind_turbine_projected_distance) + DO i1 = LBOUND(InData%upwind_turbine_projected_distance,1), UBOUND(InData%upwind_turbine_projected_distance,1) + ReKiBuf(Re_Xferred) = InData%upwind_turbine_projected_distance(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%downwind_turbine_projected_distance) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1735,8 +1714,10 @@ SUBROUTINE DWM_Packread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Indat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%downwind_turbine_projected_distance,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%downwind_turbine_projected_distance)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%downwind_turbine_projected_distance))-1 ) = PACK(InData%downwind_turbine_projected_distance,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%downwind_turbine_projected_distance) + DO i1 = LBOUND(InData%downwind_turbine_projected_distance,1), UBOUND(InData%downwind_turbine_projected_distance,1) + ReKiBuf(Re_Xferred) = InData%downwind_turbine_projected_distance(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%turbine_angle) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1751,8 +1732,12 @@ SUBROUTINE DWM_Packread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Indat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%turbine_angle,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%turbine_angle)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%turbine_angle))-1 ) = PACK(InData%turbine_angle,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%turbine_angle) + DO i2 = LBOUND(InData%turbine_angle,2), UBOUND(InData%turbine_angle,2) + DO i1 = LBOUND(InData%turbine_angle,1), UBOUND(InData%turbine_angle,1) + ReKiBuf(Re_Xferred) = InData%turbine_angle(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%upwind_align_angle) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1764,8 +1749,10 @@ SUBROUTINE DWM_Packread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Indat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_align_angle,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%upwind_align_angle)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%upwind_align_angle))-1 ) = PACK(InData%upwind_align_angle,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%upwind_align_angle) + DO i1 = LBOUND(InData%upwind_align_angle,1), UBOUND(InData%upwind_align_angle,1) + ReKiBuf(Re_Xferred) = InData%upwind_align_angle(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%downwind_align_angle) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1777,8 +1764,10 @@ SUBROUTINE DWM_Packread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Indat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%downwind_align_angle,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%downwind_align_angle)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%downwind_align_angle))-1 ) = PACK(InData%downwind_align_angle,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%downwind_align_angle) + DO i1 = LBOUND(InData%downwind_align_angle,1), UBOUND(InData%downwind_align_angle,1) + ReKiBuf(Re_Xferred) = InData%downwind_align_angle(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%upwind_turbine_Xcoor) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1790,8 +1779,10 @@ SUBROUTINE DWM_Packread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Indat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_turbine_Xcoor,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%upwind_turbine_Xcoor)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%upwind_turbine_Xcoor))-1 ) = PACK(InData%upwind_turbine_Xcoor,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%upwind_turbine_Xcoor) + DO i1 = LBOUND(InData%upwind_turbine_Xcoor,1), UBOUND(InData%upwind_turbine_Xcoor,1) + ReKiBuf(Re_Xferred) = InData%upwind_turbine_Xcoor(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%upwind_turbine_Ycoor) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1803,8 +1794,10 @@ SUBROUTINE DWM_Packread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Indat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_turbine_Ycoor,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%upwind_turbine_Ycoor)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%upwind_turbine_Ycoor))-1 ) = PACK(InData%upwind_turbine_Ycoor,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%upwind_turbine_Ycoor) + DO i1 = LBOUND(InData%upwind_turbine_Ycoor,1), UBOUND(InData%upwind_turbine_Ycoor,1) + ReKiBuf(Re_Xferred) = InData%upwind_turbine_Ycoor(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%wind_farm_Xcoor) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1816,8 +1809,10 @@ SUBROUTINE DWM_Packread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Indat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%wind_farm_Xcoor,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%wind_farm_Xcoor)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%wind_farm_Xcoor))-1 ) = PACK(InData%wind_farm_Xcoor,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%wind_farm_Xcoor) + DO i1 = LBOUND(InData%wind_farm_Xcoor,1), UBOUND(InData%wind_farm_Xcoor,1) + ReKiBuf(Re_Xferred) = InData%wind_farm_Xcoor(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%wind_farm_Ycoor) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1829,8 +1824,10 @@ SUBROUTINE DWM_Packread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Indat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%wind_farm_Ycoor,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%wind_farm_Ycoor)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%wind_farm_Ycoor))-1 ) = PACK(InData%wind_farm_Ycoor,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%wind_farm_Ycoor) + DO i1 = LBOUND(InData%wind_farm_Ycoor,1), UBOUND(InData%wind_farm_Ycoor,1) + ReKiBuf(Re_Xferred) = InData%wind_farm_Ycoor(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%downwind_turbine_Xcoor) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1842,8 +1839,10 @@ SUBROUTINE DWM_Packread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Indat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%downwind_turbine_Xcoor,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%downwind_turbine_Xcoor)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%downwind_turbine_Xcoor))-1 ) = PACK(InData%downwind_turbine_Xcoor,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%downwind_turbine_Xcoor) + DO i1 = LBOUND(InData%downwind_turbine_Xcoor,1), UBOUND(InData%downwind_turbine_Xcoor,1) + ReKiBuf(Re_Xferred) = InData%downwind_turbine_Xcoor(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%downwind_turbine_Ycoor) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1855,8 +1854,10 @@ SUBROUTINE DWM_Packread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Indat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%downwind_turbine_Ycoor,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%downwind_turbine_Ycoor)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%downwind_turbine_Ycoor))-1 ) = PACK(InData%downwind_turbine_Ycoor,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%downwind_turbine_Ycoor) + DO i1 = LBOUND(InData%downwind_turbine_Ycoor,1), UBOUND(InData%downwind_turbine_Ycoor,1) + ReKiBuf(Re_Xferred) = InData%downwind_turbine_Ycoor(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE DWM_Packread_turbine_position_data @@ -1873,12 +1874,6 @@ SUBROUTINE DWM_UnPackread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Out INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -1894,8 +1889,8 @@ SUBROUTINE DWM_UnPackread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Out Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%SimulationOrder_index = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%SimulationOrder_index = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Turbine_sort_order not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1909,18 +1904,13 @@ SUBROUTINE DWM_UnPackread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Out CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Turbine_sort_order.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Turbine_sort_order)>0) OutData%Turbine_sort_order = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%Turbine_sort_order))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%Turbine_sort_order) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Turbine_sort_order,1), UBOUND(OutData%Turbine_sort_order,1) + OutData%Turbine_sort_order(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF - OutData%WT_index = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%WT_index = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TurbineInfluenceData not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1937,15 +1927,12 @@ SUBROUTINE DWM_UnPackread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Out CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TurbineInfluenceData.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%TurbineInfluenceData)>0) OutData%TurbineInfluenceData = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%TurbineInfluenceData))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%TurbineInfluenceData) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%TurbineInfluenceData,2), UBOUND(OutData%TurbineInfluenceData,2) + DO i1 = LBOUND(OutData%TurbineInfluenceData,1), UBOUND(OutData%TurbineInfluenceData,1) + OutData%TurbineInfluenceData(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! upwind_turbine_index not allocated Int_Xferred = Int_Xferred + 1 @@ -1960,15 +1947,10 @@ SUBROUTINE DWM_UnPackread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Out CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_turbine_index.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%upwind_turbine_index)>0) OutData%upwind_turbine_index = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%upwind_turbine_index))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%upwind_turbine_index) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%upwind_turbine_index,1), UBOUND(OutData%upwind_turbine_index,1) + OutData%upwind_turbine_index(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! downwind_turbine_index not allocated Int_Xferred = Int_Xferred + 1 @@ -1983,20 +1965,15 @@ SUBROUTINE DWM_UnPackread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Out CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%downwind_turbine_index.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%downwind_turbine_index)>0) OutData%downwind_turbine_index = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%downwind_turbine_index))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%downwind_turbine_index) - DEALLOCATE(mask1) - END IF - OutData%upwindturbine_number = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%downwindturbine_number = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%downwind_turbine_index,1), UBOUND(OutData%downwind_turbine_index,1) + OutData%downwind_turbine_index(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + OutData%upwindturbine_number = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%downwindturbine_number = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! turbine_windorigin_length not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -2010,15 +1987,10 @@ SUBROUTINE DWM_UnPackread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Out CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%turbine_windorigin_length.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%turbine_windorigin_length)>0) OutData%turbine_windorigin_length = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%turbine_windorigin_length))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%turbine_windorigin_length) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%turbine_windorigin_length,1), UBOUND(OutData%turbine_windorigin_length,1) + OutData%turbine_windorigin_length(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! upwind_turbine_projected_distance not allocated Int_Xferred = Int_Xferred + 1 @@ -2033,15 +2005,10 @@ SUBROUTINE DWM_UnPackread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Out CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_turbine_projected_distance.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%upwind_turbine_projected_distance)>0) OutData%upwind_turbine_projected_distance = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%upwind_turbine_projected_distance))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%upwind_turbine_projected_distance) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%upwind_turbine_projected_distance,1), UBOUND(OutData%upwind_turbine_projected_distance,1) + OutData%upwind_turbine_projected_distance(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! downwind_turbine_projected_distance not allocated Int_Xferred = Int_Xferred + 1 @@ -2056,15 +2023,10 @@ SUBROUTINE DWM_UnPackread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Out CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%downwind_turbine_projected_distance.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%downwind_turbine_projected_distance)>0) OutData%downwind_turbine_projected_distance = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%downwind_turbine_projected_distance))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%downwind_turbine_projected_distance) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%downwind_turbine_projected_distance,1), UBOUND(OutData%downwind_turbine_projected_distance,1) + OutData%downwind_turbine_projected_distance(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! turbine_angle not allocated Int_Xferred = Int_Xferred + 1 @@ -2082,15 +2044,12 @@ SUBROUTINE DWM_UnPackread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Out CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%turbine_angle.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%turbine_angle)>0) OutData%turbine_angle = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%turbine_angle))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%turbine_angle) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%turbine_angle,2), UBOUND(OutData%turbine_angle,2) + DO i1 = LBOUND(OutData%turbine_angle,1), UBOUND(OutData%turbine_angle,1) + OutData%turbine_angle(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! upwind_align_angle not allocated Int_Xferred = Int_Xferred + 1 @@ -2105,15 +2064,10 @@ SUBROUTINE DWM_UnPackread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Out CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_align_angle.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%upwind_align_angle)>0) OutData%upwind_align_angle = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%upwind_align_angle))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%upwind_align_angle) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%upwind_align_angle,1), UBOUND(OutData%upwind_align_angle,1) + OutData%upwind_align_angle(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! downwind_align_angle not allocated Int_Xferred = Int_Xferred + 1 @@ -2128,15 +2082,10 @@ SUBROUTINE DWM_UnPackread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Out CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%downwind_align_angle.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%downwind_align_angle)>0) OutData%downwind_align_angle = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%downwind_align_angle))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%downwind_align_angle) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%downwind_align_angle,1), UBOUND(OutData%downwind_align_angle,1) + OutData%downwind_align_angle(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! upwind_turbine_Xcoor not allocated Int_Xferred = Int_Xferred + 1 @@ -2151,15 +2100,10 @@ SUBROUTINE DWM_UnPackread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Out CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_turbine_Xcoor.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%upwind_turbine_Xcoor)>0) OutData%upwind_turbine_Xcoor = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%upwind_turbine_Xcoor))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%upwind_turbine_Xcoor) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%upwind_turbine_Xcoor,1), UBOUND(OutData%upwind_turbine_Xcoor,1) + OutData%upwind_turbine_Xcoor(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! upwind_turbine_Ycoor not allocated Int_Xferred = Int_Xferred + 1 @@ -2174,15 +2118,10 @@ SUBROUTINE DWM_UnPackread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Out CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_turbine_Ycoor.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%upwind_turbine_Ycoor)>0) OutData%upwind_turbine_Ycoor = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%upwind_turbine_Ycoor))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%upwind_turbine_Ycoor) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%upwind_turbine_Ycoor,1), UBOUND(OutData%upwind_turbine_Ycoor,1) + OutData%upwind_turbine_Ycoor(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! wind_farm_Xcoor not allocated Int_Xferred = Int_Xferred + 1 @@ -2197,15 +2136,10 @@ SUBROUTINE DWM_UnPackread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Out CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%wind_farm_Xcoor.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%wind_farm_Xcoor)>0) OutData%wind_farm_Xcoor = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%wind_farm_Xcoor))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%wind_farm_Xcoor) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%wind_farm_Xcoor,1), UBOUND(OutData%wind_farm_Xcoor,1) + OutData%wind_farm_Xcoor(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! wind_farm_Ycoor not allocated Int_Xferred = Int_Xferred + 1 @@ -2220,15 +2154,10 @@ SUBROUTINE DWM_UnPackread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Out CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%wind_farm_Ycoor.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%wind_farm_Ycoor)>0) OutData%wind_farm_Ycoor = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%wind_farm_Ycoor))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%wind_farm_Ycoor) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%wind_farm_Ycoor,1), UBOUND(OutData%wind_farm_Ycoor,1) + OutData%wind_farm_Ycoor(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! downwind_turbine_Xcoor not allocated Int_Xferred = Int_Xferred + 1 @@ -2243,15 +2172,10 @@ SUBROUTINE DWM_UnPackread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Out CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%downwind_turbine_Xcoor.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%downwind_turbine_Xcoor)>0) OutData%downwind_turbine_Xcoor = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%downwind_turbine_Xcoor))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%downwind_turbine_Xcoor) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%downwind_turbine_Xcoor,1), UBOUND(OutData%downwind_turbine_Xcoor,1) + OutData%downwind_turbine_Xcoor(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! downwind_turbine_Ycoor not allocated Int_Xferred = Int_Xferred + 1 @@ -2266,15 +2190,10 @@ SUBROUTINE DWM_UnPackread_turbine_position_data( ReKiBuf, DbKiBuf, IntKiBuf, Out CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%downwind_turbine_Ycoor.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%downwind_turbine_Ycoor)>0) OutData%downwind_turbine_Ycoor = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%downwind_turbine_Ycoor))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%downwind_turbine_Ycoor) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%downwind_turbine_Ycoor,1), UBOUND(OutData%downwind_turbine_Ycoor,1) + OutData%downwind_turbine_Ycoor(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE DWM_UnPackread_turbine_position_data @@ -2400,11 +2319,13 @@ SUBROUTINE DWM_PackWeiMethod( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%sweptarea,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%sweptarea)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%sweptarea))-1 ) = PACK(InData%sweptarea,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%sweptarea) + DO i1 = LBOUND(InData%sweptarea,1), UBOUND(InData%sweptarea,1) + ReKiBuf(Re_Xferred) = InData%sweptarea(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%weighting_denominator - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%weighting_denominator + Re_Xferred = Re_Xferred + 1 END SUBROUTINE DWM_PackWeiMethod SUBROUTINE DWM_UnPackWeiMethod( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2420,12 +2341,6 @@ SUBROUTINE DWM_UnPackWeiMethod( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -2453,18 +2368,13 @@ SUBROUTINE DWM_UnPackWeiMethod( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%sweptarea.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%sweptarea)>0) OutData%sweptarea = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%sweptarea))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%sweptarea) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%sweptarea,1), UBOUND(OutData%sweptarea,1) + OutData%sweptarea(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%weighting_denominator = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%weighting_denominator = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE DWM_UnPackWeiMethod SUBROUTINE DWM_CopyTIDownstream( SrcTIDownstreamData, DstTIDownstreamData, CtrlCode, ErrStat, ErrMsg ) @@ -2651,67 +2561,71 @@ SUBROUTINE DWM_PackTIDownstream( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TI_downstream_matrix,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TI_downstream_matrix)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TI_downstream_matrix))-1 ) = PACK(InData%TI_downstream_matrix,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TI_downstream_matrix) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%i - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%j - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%k - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%cross_plane_position_ds - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%cross_plane_position_TI - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%distance_index - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%counter1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%counter2 - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%initial_timestep - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%y_axis_turbine - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%z_axis_turbine - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%distance - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TI_downstream_node - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TI_node_temp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TI_node - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TI_accumulation - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TI_apprant_accumulation - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TI_average - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TI_apprant - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HubHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%wake_center_y - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%wake_center_z - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Rscale - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%y - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%z - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%zero_spacing - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%temp1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%temp2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%temp3 - Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(InData%TI_downstream_matrix,2), UBOUND(InData%TI_downstream_matrix,2) + DO i1 = LBOUND(InData%TI_downstream_matrix,1), UBOUND(InData%TI_downstream_matrix,1) + ReKiBuf(Re_Xferred) = InData%TI_downstream_matrix(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IntKiBuf(Int_Xferred) = InData%i + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%j + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%k + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%cross_plane_position_ds + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%cross_plane_position_TI + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%distance_index + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%counter1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%counter2 + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%initial_timestep + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%y_axis_turbine + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%z_axis_turbine + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%distance + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TI_downstream_node + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TI_node_temp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TI_node + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TI_accumulation + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TI_apprant_accumulation + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TI_average + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TI_apprant + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HubHt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%wake_center_y + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%wake_center_z + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Rscale + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%y + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%z + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%zero_spacing + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%temp1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%temp2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%temp3 + Re_Xferred = Re_Xferred + 1 END SUBROUTINE DWM_PackTIDownstream SUBROUTINE DWM_UnPackTIDownstream( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2727,12 +2641,6 @@ SUBROUTINE DWM_UnPackTIDownstream( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -2764,74 +2672,71 @@ SUBROUTINE DWM_UnPackTIDownstream( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TI_downstream_matrix.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%TI_downstream_matrix)>0) OutData%TI_downstream_matrix = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TI_downstream_matrix))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TI_downstream_matrix) - DEALLOCATE(mask2) - END IF - OutData%i = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%j = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%k = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%cross_plane_position_ds = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%cross_plane_position_TI = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%distance_index = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%counter1 = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%counter2 = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%initial_timestep = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%y_axis_turbine = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%z_axis_turbine = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%distance = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TI_downstream_node = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TI_node_temp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TI_node = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TI_accumulation = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TI_apprant_accumulation = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TI_average = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TI_apprant = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HubHt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%wake_center_y = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%wake_center_z = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Rscale = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%y = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%z = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%zero_spacing = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%temp1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%temp2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%temp3 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(OutData%TI_downstream_matrix,2), UBOUND(OutData%TI_downstream_matrix,2) + DO i1 = LBOUND(OutData%TI_downstream_matrix,1), UBOUND(OutData%TI_downstream_matrix,1) + OutData%TI_downstream_matrix(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%i = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%j = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%k = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%cross_plane_position_ds = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%cross_plane_position_TI = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%distance_index = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%counter1 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%counter2 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%initial_timestep = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%y_axis_turbine = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%z_axis_turbine = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%distance = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TI_downstream_node = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TI_node_temp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TI_node = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TI_accumulation = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TI_apprant_accumulation = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TI_average = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TI_apprant = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HubHt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%wake_center_y = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%wake_center_z = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Rscale = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%y = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%z = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%zero_spacing = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%temp1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%temp2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%temp3 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE DWM_UnPackTIDownstream SUBROUTINE DWM_CopyTurbKaimal( SrcTurbKaimalData, DstTurbKaimalData, CtrlCode, ErrStat, ErrMsg ) @@ -2937,20 +2842,20 @@ SUBROUTINE DWM_PackTurbKaimal( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%fs - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%temp_n - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%i - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%low_f - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%high_f - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%lk_facor - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%STD - Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%fs + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%temp_n + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%i + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%low_f + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%high_f + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%lk_facor + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%STD + Re_Xferred = Re_Xferred + 1 END SUBROUTINE DWM_PackTurbKaimal SUBROUTINE DWM_UnPackTurbKaimal( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2966,12 +2871,6 @@ SUBROUTINE DWM_UnPackTurbKaimal( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DWM_UnPackTurbKaimal' @@ -2985,20 +2884,20 @@ SUBROUTINE DWM_UnPackTurbKaimal( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%fs = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%temp_n = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%i = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%low_f = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%high_f = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%lk_facor = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%STD = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%fs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%temp_n = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%i = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%low_f = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%high_f = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%lk_facor = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%STD = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE DWM_UnPackTurbKaimal SUBROUTINE DWM_CopyShinozuka( SrcShinozukaData, DstShinozukaData, CtrlCode, ErrStat, ErrMsg ) @@ -3217,8 +3116,10 @@ SUBROUTINE DWM_PackShinozuka( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%f_syn,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%f_syn)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%f_syn))-1 ) = PACK(InData%f_syn,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%f_syn) + DO i1 = LBOUND(InData%f_syn,1), UBOUND(InData%f_syn,1) + ReKiBuf(Re_Xferred) = InData%f_syn(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%t_syn) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3230,8 +3131,10 @@ SUBROUTINE DWM_PackShinozuka( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%t_syn,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%t_syn)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%t_syn))-1 ) = PACK(InData%t_syn,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%t_syn) + DO i1 = LBOUND(InData%t_syn,1), UBOUND(InData%t_syn,1) + ReKiBuf(Re_Xferred) = InData%t_syn(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%phi) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3243,8 +3146,10 @@ SUBROUTINE DWM_PackShinozuka( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%phi,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%phi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%phi))-1 ) = PACK(InData%phi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%phi) + DO i1 = LBOUND(InData%phi,1), UBOUND(InData%phi,1) + ReKiBuf(Re_Xferred) = InData%phi(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%p_k) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3256,8 +3161,10 @@ SUBROUTINE DWM_PackShinozuka( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%p_k,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%p_k)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%p_k))-1 ) = PACK(InData%p_k,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%p_k) + DO i1 = LBOUND(InData%p_k,1), UBOUND(InData%p_k,1) + ReKiBuf(Re_Xferred) = InData%p_k(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%a_k) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3269,25 +3176,27 @@ SUBROUTINE DWM_PackShinozuka( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%a_k,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%a_k)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%a_k))-1 ) = PACK(InData%a_k,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%a_k) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%num_points - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%ILo - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%i - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%j - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%t_min - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%t_max - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%df - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%a_k,1), UBOUND(InData%a_k,1) + ReKiBuf(Re_Xferred) = InData%a_k(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IntKiBuf(Int_Xferred) = InData%num_points + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%ILo + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%i + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%j + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%dt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%t_min + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%t_max + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%df + Re_Xferred = Re_Xferred + 1 END SUBROUTINE DWM_PackShinozuka SUBROUTINE DWM_UnPackShinozuka( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -3303,12 +3212,6 @@ SUBROUTINE DWM_UnPackShinozuka( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -3336,15 +3239,10 @@ SUBROUTINE DWM_UnPackShinozuka( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%f_syn.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%f_syn)>0) OutData%f_syn = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%f_syn))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%f_syn) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%f_syn,1), UBOUND(OutData%f_syn,1) + OutData%f_syn(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! t_syn not allocated Int_Xferred = Int_Xferred + 1 @@ -3359,15 +3257,10 @@ SUBROUTINE DWM_UnPackShinozuka( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%t_syn.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%t_syn)>0) OutData%t_syn = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%t_syn))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%t_syn) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%t_syn,1), UBOUND(OutData%t_syn,1) + OutData%t_syn(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! phi not allocated Int_Xferred = Int_Xferred + 1 @@ -3382,15 +3275,10 @@ SUBROUTINE DWM_UnPackShinozuka( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%phi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%phi)>0) OutData%phi = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%phi))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%phi) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%phi,1), UBOUND(OutData%phi,1) + OutData%phi(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! p_k not allocated Int_Xferred = Int_Xferred + 1 @@ -3405,15 +3293,10 @@ SUBROUTINE DWM_UnPackShinozuka( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%p_k.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%p_k)>0) OutData%p_k = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%p_k))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%p_k) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%p_k,1), UBOUND(OutData%p_k,1) + OutData%p_k(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! a_k not allocated Int_Xferred = Int_Xferred + 1 @@ -3428,32 +3311,27 @@ SUBROUTINE DWM_UnPackShinozuka( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%a_k.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%a_k)>0) OutData%a_k = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%a_k))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%a_k) - DEALLOCATE(mask1) - END IF - OutData%num_points = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%ILo = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%i = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%j = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%dt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%t_min = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%t_max = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%df = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%a_k,1), UBOUND(OutData%a_k,1) + OutData%a_k(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%num_points = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ILo = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%i = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%j = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%dt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%t_min = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%t_max = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%df = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE DWM_UnPackShinozuka SUBROUTINE DWM_Copysmooth_out_wake_data( Srcsmooth_out_wake_dataData, Dstsmooth_out_wake_dataData, CtrlCode, ErrStat, ErrMsg ) @@ -3547,8 +3425,8 @@ SUBROUTINE DWM_Packsmooth_out_wake_data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Err Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%length_velocity_array - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%length_velocity_array + Int_Xferred = Int_Xferred + 1 END SUBROUTINE DWM_Packsmooth_out_wake_data SUBROUTINE DWM_UnPacksmooth_out_wake_data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -3564,12 +3442,6 @@ SUBROUTINE DWM_UnPacksmooth_out_wake_data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DWM_UnPacksmooth_out_wake_data' @@ -3583,8 +3455,8 @@ SUBROUTINE DWM_UnPacksmooth_out_wake_data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%length_velocity_array = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%length_velocity_array = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE DWM_UnPacksmooth_out_wake_data SUBROUTINE DWM_CopySWSV( SrcSWSVData, DstSWSVData, CtrlCode, ErrStat, ErrMsg ) @@ -3688,18 +3560,18 @@ SUBROUTINE DWM_PackSWSV( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%p1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%p2 - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%distance - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%y0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%z0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%unit - Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%p1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%p2 + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%distance + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%y0 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%z0 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%unit + Re_Xferred = Re_Xferred + 1 END SUBROUTINE DWM_PackSWSV SUBROUTINE DWM_UnPackSWSV( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -3715,12 +3587,6 @@ SUBROUTINE DWM_UnPackSWSV( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DWM_UnPackSWSV' @@ -3734,18 +3600,18 @@ SUBROUTINE DWM_UnPackSWSV( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%p1 = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%p2 = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%distance = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%y0 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%z0 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%unit = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%p1 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%p2 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%distance = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%y0 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%z0 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%unit = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE DWM_UnPackSWSV SUBROUTINE DWM_Copyread_upwind_result( Srcread_upwind_resultData, Dstread_upwind_resultData, CtrlCode, ErrStat, ErrMsg ) @@ -4090,8 +3956,12 @@ SUBROUTINE DWM_Packread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_U,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%upwind_U)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%upwind_U))-1 ) = PACK(InData%upwind_U,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%upwind_U) + DO i2 = LBOUND(InData%upwind_U,2), UBOUND(InData%upwind_U,2) + DO i1 = LBOUND(InData%upwind_U,1), UBOUND(InData%upwind_U,1) + ReKiBuf(Re_Xferred) = InData%upwind_U(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%upwind_wakecenter) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4112,8 +3982,16 @@ SUBROUTINE DWM_Packread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_wakecenter,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%upwind_wakecenter)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%upwind_wakecenter))-1 ) = PACK(InData%upwind_wakecenter,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%upwind_wakecenter) + DO i4 = LBOUND(InData%upwind_wakecenter,4), UBOUND(InData%upwind_wakecenter,4) + DO i3 = LBOUND(InData%upwind_wakecenter,3), UBOUND(InData%upwind_wakecenter,3) + DO i2 = LBOUND(InData%upwind_wakecenter,2), UBOUND(InData%upwind_wakecenter,2) + DO i1 = LBOUND(InData%upwind_wakecenter,1), UBOUND(InData%upwind_wakecenter,1) + ReKiBuf(Re_Xferred) = InData%upwind_wakecenter(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%upwind_meanU) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4125,8 +4003,10 @@ SUBROUTINE DWM_Packread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_meanU,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%upwind_meanU)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%upwind_meanU))-1 ) = PACK(InData%upwind_meanU,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%upwind_meanU) + DO i1 = LBOUND(InData%upwind_meanU,1), UBOUND(InData%upwind_meanU,1) + ReKiBuf(Re_Xferred) = InData%upwind_meanU(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%upwind_TI) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4138,8 +4018,10 @@ SUBROUTINE DWM_Packread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_TI,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%upwind_TI)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%upwind_TI))-1 ) = PACK(InData%upwind_TI,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%upwind_TI) + DO i1 = LBOUND(InData%upwind_TI,1), UBOUND(InData%upwind_TI,1) + ReKiBuf(Re_Xferred) = InData%upwind_TI(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%upwind_small_TI) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4151,8 +4033,10 @@ SUBROUTINE DWM_Packread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_small_TI,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%upwind_small_TI)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%upwind_small_TI))-1 ) = PACK(InData%upwind_small_TI,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%upwind_small_TI) + DO i1 = LBOUND(InData%upwind_small_TI,1), UBOUND(InData%upwind_small_TI,1) + ReKiBuf(Re_Xferred) = InData%upwind_small_TI(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%upwind_smoothWake) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4167,8 +4051,12 @@ SUBROUTINE DWM_Packread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt IntKiBuf( Int_Xferred + 1) = UBOUND(InData%upwind_smoothWake,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%upwind_smoothWake)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%upwind_smoothWake))-1 ) = PACK(InData%upwind_smoothWake,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%upwind_smoothWake) + DO i2 = LBOUND(InData%upwind_smoothWake,2), UBOUND(InData%upwind_smoothWake,2) + DO i1 = LBOUND(InData%upwind_smoothWake,1), UBOUND(InData%upwind_smoothWake,1) + ReKiBuf(Re_Xferred) = InData%upwind_smoothWake(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%velocity_aerodyn) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4180,8 +4068,10 @@ SUBROUTINE DWM_Packread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt IntKiBuf( Int_Xferred + 1) = UBOUND(InData%velocity_aerodyn,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%velocity_aerodyn)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%velocity_aerodyn))-1 ) = PACK(InData%velocity_aerodyn,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%velocity_aerodyn) + DO i1 = LBOUND(InData%velocity_aerodyn,1), UBOUND(InData%velocity_aerodyn,1) + ReKiBuf(Re_Xferred) = InData%velocity_aerodyn(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TI_downstream) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4193,8 +4083,10 @@ SUBROUTINE DWM_Packread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TI_downstream,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TI_downstream)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TI_downstream))-1 ) = PACK(InData%TI_downstream,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TI_downstream) + DO i1 = LBOUND(InData%TI_downstream,1), UBOUND(InData%TI_downstream,1) + ReKiBuf(Re_Xferred) = InData%TI_downstream(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%small_scale_TI_downstream) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4206,8 +4098,10 @@ SUBROUTINE DWM_Packread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt IntKiBuf( Int_Xferred + 1) = UBOUND(InData%small_scale_TI_downstream,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%small_scale_TI_downstream)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%small_scale_TI_downstream))-1 ) = PACK(InData%small_scale_TI_downstream,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%small_scale_TI_downstream) + DO i1 = LBOUND(InData%small_scale_TI_downstream,1), UBOUND(InData%small_scale_TI_downstream,1) + ReKiBuf(Re_Xferred) = InData%small_scale_TI_downstream(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%smoothed_velocity_array) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4222,8 +4116,12 @@ SUBROUTINE DWM_Packread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt IntKiBuf( Int_Xferred + 1) = UBOUND(InData%smoothed_velocity_array,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%smoothed_velocity_array)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%smoothed_velocity_array))-1 ) = PACK(InData%smoothed_velocity_array,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%smoothed_velocity_array) + DO i2 = LBOUND(InData%smoothed_velocity_array,2), UBOUND(InData%smoothed_velocity_array,2) + DO i1 = LBOUND(InData%smoothed_velocity_array,1), UBOUND(InData%smoothed_velocity_array,1) + ReKiBuf(Re_Xferred) = InData%smoothed_velocity_array(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%vel_matrix) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4241,8 +4139,14 @@ SUBROUTINE DWM_Packread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vel_matrix,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%vel_matrix)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%vel_matrix))-1 ) = PACK(InData%vel_matrix,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%vel_matrix) + DO i3 = LBOUND(InData%vel_matrix,3), UBOUND(InData%vel_matrix,3) + DO i2 = LBOUND(InData%vel_matrix,2), UBOUND(InData%vel_matrix,2) + DO i1 = LBOUND(InData%vel_matrix,1), UBOUND(InData%vel_matrix,1) + ReKiBuf(Re_Xferred) = InData%vel_matrix(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF END SUBROUTINE DWM_Packread_upwind_result @@ -4259,12 +4163,6 @@ SUBROUTINE DWM_UnPackread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (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 @@ -4298,15 +4196,12 @@ SUBROUTINE DWM_UnPackread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_U.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%upwind_U)>0) OutData%upwind_U = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%upwind_U))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%upwind_U) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%upwind_U,2), UBOUND(OutData%upwind_U,2) + DO i1 = LBOUND(OutData%upwind_U,1), UBOUND(OutData%upwind_U,1) + OutData%upwind_U(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! upwind_wakecenter not allocated Int_Xferred = Int_Xferred + 1 @@ -4330,15 +4225,16 @@ SUBROUTINE DWM_UnPackread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_wakecenter.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%upwind_wakecenter)>0) OutData%upwind_wakecenter = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%upwind_wakecenter))-1 ), mask4, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%upwind_wakecenter) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%upwind_wakecenter,4), UBOUND(OutData%upwind_wakecenter,4) + DO i3 = LBOUND(OutData%upwind_wakecenter,3), UBOUND(OutData%upwind_wakecenter,3) + DO i2 = LBOUND(OutData%upwind_wakecenter,2), UBOUND(OutData%upwind_wakecenter,2) + DO i1 = LBOUND(OutData%upwind_wakecenter,1), UBOUND(OutData%upwind_wakecenter,1) + OutData%upwind_wakecenter(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! upwind_meanU not allocated Int_Xferred = Int_Xferred + 1 @@ -4353,15 +4249,10 @@ SUBROUTINE DWM_UnPackread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_meanU.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%upwind_meanU)>0) OutData%upwind_meanU = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%upwind_meanU))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%upwind_meanU) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%upwind_meanU,1), UBOUND(OutData%upwind_meanU,1) + OutData%upwind_meanU(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! upwind_TI not allocated Int_Xferred = Int_Xferred + 1 @@ -4376,15 +4267,10 @@ SUBROUTINE DWM_UnPackread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_TI.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%upwind_TI)>0) OutData%upwind_TI = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%upwind_TI))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%upwind_TI) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%upwind_TI,1), UBOUND(OutData%upwind_TI,1) + OutData%upwind_TI(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! upwind_small_TI not allocated Int_Xferred = Int_Xferred + 1 @@ -4399,15 +4285,10 @@ SUBROUTINE DWM_UnPackread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_small_TI.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%upwind_small_TI)>0) OutData%upwind_small_TI = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%upwind_small_TI))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%upwind_small_TI) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%upwind_small_TI,1), UBOUND(OutData%upwind_small_TI,1) + OutData%upwind_small_TI(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! upwind_smoothWake not allocated Int_Xferred = Int_Xferred + 1 @@ -4425,15 +4306,12 @@ SUBROUTINE DWM_UnPackread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%upwind_smoothWake.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%upwind_smoothWake)>0) OutData%upwind_smoothWake = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%upwind_smoothWake))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%upwind_smoothWake) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%upwind_smoothWake,2), UBOUND(OutData%upwind_smoothWake,2) + DO i1 = LBOUND(OutData%upwind_smoothWake,1), UBOUND(OutData%upwind_smoothWake,1) + OutData%upwind_smoothWake(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! velocity_aerodyn not allocated Int_Xferred = Int_Xferred + 1 @@ -4448,15 +4326,10 @@ SUBROUTINE DWM_UnPackread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%velocity_aerodyn.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%velocity_aerodyn)>0) OutData%velocity_aerodyn = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%velocity_aerodyn))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%velocity_aerodyn) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%velocity_aerodyn,1), UBOUND(OutData%velocity_aerodyn,1) + OutData%velocity_aerodyn(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TI_downstream not allocated Int_Xferred = Int_Xferred + 1 @@ -4471,15 +4344,10 @@ SUBROUTINE DWM_UnPackread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TI_downstream.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TI_downstream)>0) OutData%TI_downstream = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TI_downstream))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TI_downstream) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TI_downstream,1), UBOUND(OutData%TI_downstream,1) + OutData%TI_downstream(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! small_scale_TI_downstream not allocated Int_Xferred = Int_Xferred + 1 @@ -4494,15 +4362,10 @@ SUBROUTINE DWM_UnPackread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%small_scale_TI_downstream.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%small_scale_TI_downstream)>0) OutData%small_scale_TI_downstream = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%small_scale_TI_downstream))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%small_scale_TI_downstream) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%small_scale_TI_downstream,1), UBOUND(OutData%small_scale_TI_downstream,1) + OutData%small_scale_TI_downstream(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! smoothed_velocity_array not allocated Int_Xferred = Int_Xferred + 1 @@ -4520,15 +4383,12 @@ SUBROUTINE DWM_UnPackread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%smoothed_velocity_array.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%smoothed_velocity_array)>0) OutData%smoothed_velocity_array = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%smoothed_velocity_array))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%smoothed_velocity_array) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%smoothed_velocity_array,2), UBOUND(OutData%smoothed_velocity_array,2) + DO i1 = LBOUND(OutData%smoothed_velocity_array,1), UBOUND(OutData%smoothed_velocity_array,1) + OutData%smoothed_velocity_array(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! vel_matrix not allocated Int_Xferred = Int_Xferred + 1 @@ -4549,15 +4409,14 @@ SUBROUTINE DWM_UnPackread_upwind_result( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%vel_matrix.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%vel_matrix)>0) OutData%vel_matrix = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%vel_matrix))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%vel_matrix) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%vel_matrix,3), UBOUND(OutData%vel_matrix,3) + DO i2 = LBOUND(OutData%vel_matrix,2), UBOUND(OutData%vel_matrix,2) + DO i1 = LBOUND(OutData%vel_matrix,1), UBOUND(OutData%vel_matrix,1) + OutData%vel_matrix(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF END SUBROUTINE DWM_UnPackread_upwind_result @@ -4681,8 +4540,10 @@ SUBROUTINE DWM_Packwake_meandered_center( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%wake_width,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%wake_width)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%wake_width))-1 ) = PACK(InData%wake_width,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%wake_width) + DO i1 = LBOUND(InData%wake_width,1), UBOUND(InData%wake_width,1) + IntKiBuf(Int_Xferred) = InData%wake_width(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF END SUBROUTINE DWM_Packwake_meandered_center @@ -4699,12 +4560,6 @@ SUBROUTINE DWM_UnPackwake_meandered_center( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -4732,15 +4587,10 @@ SUBROUTINE DWM_UnPackwake_meandered_center( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%wake_width.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%wake_width)>0) OutData%wake_width = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%wake_width))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%wake_width) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%wake_width,1), UBOUND(OutData%wake_width,1) + OutData%wake_width(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF END SUBROUTINE DWM_UnPackwake_meandered_center @@ -4839,12 +4689,12 @@ SUBROUTINE DWM_Packturbine_blade( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Aerodyn_turbine_num - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Blade_index - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Element_index - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Aerodyn_turbine_num + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Blade_index + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Element_index + Int_Xferred = Int_Xferred + 1 END SUBROUTINE DWM_Packturbine_blade SUBROUTINE DWM_UnPackturbine_blade( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -4860,12 +4710,6 @@ SUBROUTINE DWM_UnPackturbine_blade( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DWM_UnPackturbine_blade' @@ -4879,12 +4723,12 @@ SUBROUTINE DWM_UnPackturbine_blade( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%Aerodyn_turbine_num = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%Blade_index = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%Element_index = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%Aerodyn_turbine_num = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%Blade_index = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%Element_index = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE DWM_UnPackturbine_blade SUBROUTINE DWM_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -5158,8 +5002,10 @@ SUBROUTINE DWM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%velocityU,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%velocityU)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%velocityU))-1 ) = PACK(InData%velocityU,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%velocityU) + DO i1 = LBOUND(InData%velocityU,1), UBOUND(InData%velocityU,1) + ReKiBuf(Re_Xferred) = InData%velocityU(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%smoothed_wake) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5171,8 +5017,10 @@ SUBROUTINE DWM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%smoothed_wake,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%smoothed_wake)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%smoothed_wake))-1 ) = PACK(InData%smoothed_wake,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%smoothed_wake) + DO i1 = LBOUND(InData%smoothed_wake,1), UBOUND(InData%smoothed_wake,1) + ReKiBuf(Re_Xferred) = InData%smoothed_wake(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WakePosition) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5190,47 +5038,53 @@ SUBROUTINE DWM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WakePosition,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WakePosition)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WakePosition))-1 ) = PACK(InData%WakePosition,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WakePosition) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WakePosition_1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WakePosition_2 - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%smooth_flag - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%p_p_r - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumWT - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Tinfluencer - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RotorR - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%r_domain - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%x_domain - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Uambient - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TI_amb - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TI_wake - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%hub_height - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%length_velocityU - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WFLowerBd - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Wind_file_Mean_u - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Winddir - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%air_density - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RR - Re_Xferred = Re_Xferred + 1 + DO i3 = LBOUND(InData%WakePosition,3), UBOUND(InData%WakePosition,3) + DO i2 = LBOUND(InData%WakePosition,2), UBOUND(InData%WakePosition,2) + DO i1 = LBOUND(InData%WakePosition,1), UBOUND(InData%WakePosition,1) + ReKiBuf(Re_Xferred) = InData%WakePosition(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IntKiBuf(Int_Xferred) = InData%WakePosition_1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WakePosition_2 + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%smooth_flag + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%p_p_r + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumWT + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Tinfluencer + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RotorR + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%r_domain + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%x_domain + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Uambient + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TI_amb + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TI_wake + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%hub_height + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%length_velocityU + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WFLowerBd + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Wind_file_Mean_u + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Winddir + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%air_density + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RR + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%ElementRad) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -5241,13 +5095,15 @@ SUBROUTINE DWM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElementRad,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ElementRad)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%ElementRad))-1 ) = PACK(InData%ElementRad,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%ElementRad) + DO i1 = LBOUND(InData%ElementRad,1), UBOUND(InData%ElementRad,1) + ReKiBuf(Re_Xferred) = InData%ElementRad(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Bnum - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%ElementNum - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Bnum + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%ElementNum + Int_Xferred = Int_Xferred + 1 CALL DWM_Packread_turbine_position_data( Re_Buf, Db_Buf, Int_Buf, InData%RTPD, ErrStat2, ErrMsg2, OnlySize ) ! RTPD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -5319,12 +5175,6 @@ SUBROUTINE DWM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (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 @@ -5354,15 +5204,10 @@ SUBROUTINE DWM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%velocityU.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%velocityU)>0) OutData%velocityU = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%velocityU))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%velocityU) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%velocityU,1), UBOUND(OutData%velocityU,1) + OutData%velocityU(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! smoothed_wake not allocated Int_Xferred = Int_Xferred + 1 @@ -5377,15 +5222,10 @@ SUBROUTINE DWM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%smoothed_wake.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%smoothed_wake)>0) OutData%smoothed_wake = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%smoothed_wake))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%smoothed_wake) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%smoothed_wake,1), UBOUND(OutData%smoothed_wake,1) + OutData%smoothed_wake(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WakePosition not allocated Int_Xferred = Int_Xferred + 1 @@ -5406,54 +5246,53 @@ SUBROUTINE DWM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WakePosition.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%WakePosition)>0) OutData%WakePosition = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WakePosition))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WakePosition) - DEALLOCATE(mask3) - END IF - OutData%WakePosition_1 = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%WakePosition_2 = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%smooth_flag = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%p_p_r = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumWT = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%Tinfluencer = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%RotorR = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%r_domain = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%x_domain = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Uambient = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TI_amb = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TI_wake = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%hub_height = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%length_velocityU = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%WFLowerBd = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Wind_file_Mean_u = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Winddir = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%air_density = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RR = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i3 = LBOUND(OutData%WakePosition,3), UBOUND(OutData%WakePosition,3) + DO i2 = LBOUND(OutData%WakePosition,2), UBOUND(OutData%WakePosition,2) + DO i1 = LBOUND(OutData%WakePosition,1), UBOUND(OutData%WakePosition,1) + OutData%WakePosition(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + OutData%WakePosition_1 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WakePosition_2 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%smooth_flag = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%p_p_r = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumWT = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%Tinfluencer = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%RotorR = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%r_domain = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%x_domain = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Uambient = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TI_amb = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TI_wake = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%hub_height = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%length_velocityU = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WFLowerBd = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Wind_file_Mean_u = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Winddir = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%air_density = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RR = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ElementRad not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5467,20 +5306,15 @@ SUBROUTINE DWM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElementRad.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%ElementRad)>0) OutData%ElementRad = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%ElementRad))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%ElementRad) - DEALLOCATE(mask1) - END IF - OutData%Bnum = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%ElementNum = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%ElementRad,1), UBOUND(OutData%ElementRad,1) + OutData%ElementRad(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%Bnum = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ElementNum = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -5717,12 +5551,6 @@ SUBROUTINE DWM_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DWM_UnPackOtherState' @@ -6235,18 +6063,18 @@ SUBROUTINE DWM_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%position_y - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%position_z - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%velocity_wake_mean - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%shifted_velocity_Aerodyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%U_velocity - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%V_velocity - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%position_y + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%position_z + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%velocity_wake_mean + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%shifted_velocity_Aerodyn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%U_velocity + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%V_velocity + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%Nforce) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -6260,8 +6088,12 @@ SUBROUTINE DWM_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nforce,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Nforce)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Nforce))-1 ) = PACK(InData%Nforce,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Nforce) + DO i2 = LBOUND(InData%Nforce,2), UBOUND(InData%Nforce,2) + DO i1 = LBOUND(InData%Nforce,1), UBOUND(InData%Nforce,1) + ReKiBuf(Re_Xferred) = InData%Nforce(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%blade_dr) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6273,13 +6105,15 @@ SUBROUTINE DWM_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%blade_dr,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%blade_dr)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%blade_dr))-1 ) = PACK(InData%blade_dr,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%blade_dr) + DO i1 = LBOUND(InData%blade_dr,1), UBOUND(InData%blade_dr,1) + ReKiBuf(Re_Xferred) = InData%blade_dr(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NacYaw - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TI_original - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NacYaw + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TI_original + Re_Xferred = Re_Xferred + 1 CALL DWM_Packturbine_average_velocity_data( Re_Buf, Db_Buf, Int_Buf, InData%TAVD, ErrStat2, ErrMsg2, OnlySize ) ! TAVD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6560,12 +6394,12 @@ SUBROUTINE DWM_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ct_tilde - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%FAST_Time - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%SDtimestep - Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%ct_tilde + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FAST_Time + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%SDtimestep + Int_Xferred = Int_Xferred + 1 CALL DWM_Packturbine_blade( Re_Buf, Db_Buf, Int_Buf, InData%DWM_tb, ErrStat2, ErrMsg2, OnlySize ) ! DWM_tb CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6637,12 +6471,6 @@ SUBROUTINE DWM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -6698,18 +6526,18 @@ SUBROUTINE DWM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%position_y = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%position_z = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%velocity_wake_mean = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%shifted_velocity_Aerodyn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%U_velocity = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%V_velocity = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%position_y = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%position_z = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%velocity_wake_mean = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%shifted_velocity_Aerodyn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%U_velocity = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%V_velocity = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Nforce not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -6726,15 +6554,12 @@ SUBROUTINE DWM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nforce.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Nforce)>0) OutData%Nforce = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Nforce))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Nforce) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Nforce,2), UBOUND(OutData%Nforce,2) + DO i1 = LBOUND(OutData%Nforce,1), UBOUND(OutData%Nforce,1) + OutData%Nforce(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! blade_dr not allocated Int_Xferred = Int_Xferred + 1 @@ -6749,20 +6574,15 @@ SUBROUTINE DWM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%blade_dr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%blade_dr)>0) OutData%blade_dr = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%blade_dr))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%blade_dr) - DEALLOCATE(mask1) - END IF - OutData%NacYaw = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TI_original = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%blade_dr,1), UBOUND(OutData%blade_dr,1) + OutData%blade_dr(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%NacYaw = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TI_original = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -7163,12 +6983,12 @@ SUBROUTINE DWM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%ct_tilde = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%FAST_Time = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SDtimestep = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%ct_tilde = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%FAST_Time = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SDtimestep = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -7454,12 +7274,6 @@ SUBROUTINE DWM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DWM_UnPackInput' @@ -7863,8 +7677,10 @@ SUBROUTINE DWM_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%turbine_thrust_force,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%turbine_thrust_force)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%turbine_thrust_force))-1 ) = PACK(InData%turbine_thrust_force,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%turbine_thrust_force) + DO i1 = LBOUND(InData%turbine_thrust_force,1), UBOUND(InData%turbine_thrust_force,1) + ReKiBuf(Re_Xferred) = InData%turbine_thrust_force(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%induction_factor) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7876,8 +7692,10 @@ SUBROUTINE DWM_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%induction_factor,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%induction_factor)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%induction_factor))-1 ) = PACK(InData%induction_factor,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%induction_factor) + DO i1 = LBOUND(InData%induction_factor,1), UBOUND(InData%induction_factor,1) + ReKiBuf(Re_Xferred) = InData%induction_factor(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%r_initial) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7889,8 +7707,10 @@ SUBROUTINE DWM_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r_initial,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%r_initial)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%r_initial))-1 ) = PACK(InData%r_initial,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%r_initial) + DO i1 = LBOUND(InData%r_initial,1), UBOUND(InData%r_initial,1) + ReKiBuf(Re_Xferred) = InData%r_initial(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%U_initial) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7902,8 +7722,10 @@ SUBROUTINE DWM_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%U_initial,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%U_initial)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%U_initial))-1 ) = PACK(InData%U_initial,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%U_initial) + DO i1 = LBOUND(InData%U_initial,1), UBOUND(InData%U_initial,1) + ReKiBuf(Re_Xferred) = InData%U_initial(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%Mean_FFWS_array) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7915,15 +7737,17 @@ SUBROUTINE DWM_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Mean_FFWS_array,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Mean_FFWS_array)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Mean_FFWS_array))-1 ) = PACK(InData%Mean_FFWS_array,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Mean_FFWS_array) + DO i1 = LBOUND(InData%Mean_FFWS_array,1), UBOUND(InData%Mean_FFWS_array,1) + ReKiBuf(Re_Xferred) = InData%Mean_FFWS_array(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Mean_FFWS - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TI - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TI_downstream - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Mean_FFWS + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TI + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TI_downstream + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%wake_u) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -7937,8 +7761,12 @@ SUBROUTINE DWM_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%wake_u,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%wake_u)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%wake_u))-1 ) = PACK(InData%wake_u,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%wake_u) + DO i2 = LBOUND(InData%wake_u,2), UBOUND(InData%wake_u,2) + DO i1 = LBOUND(InData%wake_u,1), UBOUND(InData%wake_u,1) + ReKiBuf(Re_Xferred) = InData%wake_u(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%wake_position) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7956,8 +7784,14 @@ SUBROUTINE DWM_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%wake_position,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%wake_position)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%wake_position))-1 ) = PACK(InData%wake_position,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%wake_position) + DO i3 = LBOUND(InData%wake_position,3), UBOUND(InData%wake_position,3) + DO i2 = LBOUND(InData%wake_position,2), UBOUND(InData%wake_position,2) + DO i1 = LBOUND(InData%wake_position,1), UBOUND(InData%wake_position,1) + ReKiBuf(Re_Xferred) = InData%wake_position(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%smoothed_velocity_array) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7972,19 +7806,23 @@ SUBROUTINE DWM_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%smoothed_velocity_array,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%smoothed_velocity_array)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%smoothed_velocity_array))-1 ) = PACK(InData%smoothed_velocity_array,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%smoothed_velocity_array) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AtmUscale - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%du_dz_ABL - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%total_SDgenpwr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%mean_SDgenpwr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%avg_ct - Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(InData%smoothed_velocity_array,2), UBOUND(InData%smoothed_velocity_array,2) + DO i1 = LBOUND(InData%smoothed_velocity_array,1), UBOUND(InData%smoothed_velocity_array,1) + ReKiBuf(Re_Xferred) = InData%smoothed_velocity_array(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + ReKiBuf(Re_Xferred) = InData%AtmUscale + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%du_dz_ABL + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%total_SDgenpwr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%mean_SDgenpwr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%avg_ct + Re_Xferred = Re_Xferred + 1 CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, OnlySize ) ! IfW CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -8028,12 +7866,6 @@ SUBROUTINE DWM_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (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 @@ -8063,15 +7895,10 @@ SUBROUTINE DWM_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%turbine_thrust_force.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%turbine_thrust_force)>0) OutData%turbine_thrust_force = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%turbine_thrust_force))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%turbine_thrust_force) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%turbine_thrust_force,1), UBOUND(OutData%turbine_thrust_force,1) + OutData%turbine_thrust_force(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! induction_factor not allocated Int_Xferred = Int_Xferred + 1 @@ -8086,15 +7913,10 @@ SUBROUTINE DWM_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%induction_factor.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%induction_factor)>0) OutData%induction_factor = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%induction_factor))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%induction_factor) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%induction_factor,1), UBOUND(OutData%induction_factor,1) + OutData%induction_factor(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! r_initial not allocated Int_Xferred = Int_Xferred + 1 @@ -8109,15 +7931,10 @@ SUBROUTINE DWM_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%r_initial.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%r_initial)>0) OutData%r_initial = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%r_initial))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%r_initial) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%r_initial,1), UBOUND(OutData%r_initial,1) + OutData%r_initial(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! U_initial not allocated Int_Xferred = Int_Xferred + 1 @@ -8132,15 +7949,10 @@ SUBROUTINE DWM_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%U_initial.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%U_initial)>0) OutData%U_initial = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%U_initial))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%U_initial) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%U_initial,1), UBOUND(OutData%U_initial,1) + OutData%U_initial(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Mean_FFWS_array not allocated Int_Xferred = Int_Xferred + 1 @@ -8155,22 +7967,17 @@ SUBROUTINE DWM_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mean_FFWS_array.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Mean_FFWS_array)>0) OutData%Mean_FFWS_array = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Mean_FFWS_array))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Mean_FFWS_array) - DEALLOCATE(mask1) - END IF - OutData%Mean_FFWS = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TI = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TI_downstream = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%Mean_FFWS_array,1), UBOUND(OutData%Mean_FFWS_array,1) + OutData%Mean_FFWS_array(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%Mean_FFWS = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TI = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TI_downstream = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! wake_u not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -8187,15 +7994,12 @@ SUBROUTINE DWM_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%wake_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%wake_u)>0) OutData%wake_u = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%wake_u))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%wake_u) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%wake_u,2), UBOUND(OutData%wake_u,2) + DO i1 = LBOUND(OutData%wake_u,1), UBOUND(OutData%wake_u,1) + OutData%wake_u(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! wake_position not allocated Int_Xferred = Int_Xferred + 1 @@ -8216,15 +8020,14 @@ SUBROUTINE DWM_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%wake_position.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%wake_position)>0) OutData%wake_position = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%wake_position))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%wake_position) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%wake_position,3), UBOUND(OutData%wake_position,3) + DO i2 = LBOUND(OutData%wake_position,2), UBOUND(OutData%wake_position,2) + DO i1 = LBOUND(OutData%wake_position,1), UBOUND(OutData%wake_position,1) + OutData%wake_position(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! smoothed_velocity_array not allocated Int_Xferred = Int_Xferred + 1 @@ -8242,26 +8045,23 @@ SUBROUTINE DWM_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%smoothed_velocity_array.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%smoothed_velocity_array)>0) OutData%smoothed_velocity_array = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%smoothed_velocity_array))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%smoothed_velocity_array) - DEALLOCATE(mask2) - END IF - OutData%AtmUscale = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%du_dz_ABL = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%total_SDgenpwr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%mean_SDgenpwr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%avg_ct = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(OutData%smoothed_velocity_array,2), UBOUND(OutData%smoothed_velocity_array,2) + DO i1 = LBOUND(OutData%smoothed_velocity_array,1), UBOUND(OutData%smoothed_velocity_array,1) + OutData%smoothed_velocity_array(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%AtmUscale = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%du_dz_ABL = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%total_SDgenpwr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%mean_SDgenpwr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%avg_ct = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -8417,8 +8217,8 @@ SUBROUTINE DWM_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dummy - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%dummy + Re_Xferred = Re_Xferred + 1 CALL InflowWind_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, OnlySize ) ! IfW CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -8462,12 +8262,6 @@ SUBROUTINE DWM_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DWM_UnPackContState' @@ -8481,8 +8275,8 @@ SUBROUTINE DWM_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%dummy = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%dummy = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -8638,8 +8432,8 @@ SUBROUTINE DWM_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dummy - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%dummy + Re_Xferred = Re_Xferred + 1 CALL InflowWind_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, OnlySize ) ! IfW CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -8683,12 +8477,6 @@ SUBROUTINE DWM_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DWM_UnPackDiscState' @@ -8702,8 +8490,8 @@ SUBROUTINE DWM_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%dummy = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%dummy = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -8859,8 +8647,8 @@ SUBROUTINE DWM_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dummy - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%dummy + Re_Xferred = Re_Xferred + 1 CALL InflowWind_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, OnlySize ) ! IfW CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -8904,12 +8692,6 @@ SUBROUTINE DWM_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DWM_UnPackConstrState' @@ -8923,8 +8705,8 @@ SUBROUTINE DWM_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%dummy = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%dummy = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -9080,8 +8862,8 @@ SUBROUTINE DWM_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dummy - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%dummy + Re_Xferred = Re_Xferred + 1 CALL InflowWind_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, OnlySize ) ! IfW CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -9125,12 +8907,6 @@ SUBROUTINE DWM_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DWM_UnPackInitInput' @@ -9144,8 +8920,8 @@ SUBROUTINE DWM_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%dummy = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%dummy = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -9301,8 +9077,8 @@ SUBROUTINE DWM_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dummy - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%dummy + Re_Xferred = Re_Xferred + 1 CALL InflowWind_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%IfW, ErrStat2, ErrMsg2, OnlySize ) ! IfW CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -9346,12 +9122,6 @@ SUBROUTINE DWM_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'DWM_UnPackInitOutput' @@ -9365,8 +9135,8 @@ SUBROUTINE DWM_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%dummy = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%dummy = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -9484,18 +9254,18 @@ SUBROUTINE DWM_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'DWM_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: b3 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: c3 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:,:) :: b4 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:,:) :: c4 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts + INTEGER :: i04 ! dim4 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + INTEGER :: i3 ! dim3 counter variable for arrays + INTEGER :: i4 ! dim4 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -9508,97 +9278,89 @@ SUBROUTINE DWM_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) IF (ALLOCATED(u_out%Upwind_result%upwind_U) .AND. ALLOCATED(u1%Upwind_result%upwind_U)) THEN - ALLOCATE(b2(SIZE(u_out%Upwind_result%upwind_U,1),SIZE(u_out%Upwind_result%upwind_U,2) )) - ALLOCATE(c2(SIZE(u_out%Upwind_result%upwind_U,1),SIZE(u_out%Upwind_result%upwind_U,2) )) - b2 = -(u1%Upwind_result%upwind_U - u2%Upwind_result%upwind_U)/t(2) - u_out%Upwind_result%upwind_U = u1%Upwind_result%upwind_U + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%Upwind_result%upwind_U,2),UBOUND(u_out%Upwind_result%upwind_U,2) + DO i1 = LBOUND(u_out%Upwind_result%upwind_U,1),UBOUND(u_out%Upwind_result%upwind_U,1) + b = -(u1%Upwind_result%upwind_U(i1,i2) - u2%Upwind_result%upwind_U(i1,i2)) + u_out%Upwind_result%upwind_U(i1,i2) = u1%Upwind_result%upwind_U(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated IF (ALLOCATED(u_out%Upwind_result%upwind_wakecenter) .AND. ALLOCATED(u1%Upwind_result%upwind_wakecenter)) THEN - ALLOCATE(b4(SIZE(u_out%Upwind_result%upwind_wakecenter,1),SIZE(u_out%Upwind_result%upwind_wakecenter,2), & - SIZE(u_out%Upwind_result%upwind_wakecenter,3),SIZE(u_out%Upwind_result%upwind_wakecenter,4) )) - ALLOCATE(c4(SIZE(u_out%Upwind_result%upwind_wakecenter,1),SIZE(u_out%Upwind_result%upwind_wakecenter,2), & - SIZE(u_out%Upwind_result%upwind_wakecenter,3),SIZE(u_out%Upwind_result%upwind_wakecenter,4) )) - b4 = -(u1%Upwind_result%upwind_wakecenter - u2%Upwind_result%upwind_wakecenter)/t(2) - u_out%Upwind_result%upwind_wakecenter = u1%Upwind_result%upwind_wakecenter + b4 * t_out - DEALLOCATE(b4) - DEALLOCATE(c4) + DO i4 = LBOUND(u_out%Upwind_result%upwind_wakecenter,4),UBOUND(u_out%Upwind_result%upwind_wakecenter,4) + DO i3 = LBOUND(u_out%Upwind_result%upwind_wakecenter,3),UBOUND(u_out%Upwind_result%upwind_wakecenter,3) + DO i2 = LBOUND(u_out%Upwind_result%upwind_wakecenter,2),UBOUND(u_out%Upwind_result%upwind_wakecenter,2) + DO i1 = LBOUND(u_out%Upwind_result%upwind_wakecenter,1),UBOUND(u_out%Upwind_result%upwind_wakecenter,1) + b = -(u1%Upwind_result%upwind_wakecenter(i1,i2,i3,i4) - u2%Upwind_result%upwind_wakecenter(i1,i2,i3,i4)) + u_out%Upwind_result%upwind_wakecenter(i1,i2,i3,i4) = u1%Upwind_result%upwind_wakecenter(i1,i2,i3,i4) + b * ScaleFactor + END DO + END DO + END DO + END DO END IF ! check if allocated IF (ALLOCATED(u_out%Upwind_result%upwind_meanU) .AND. ALLOCATED(u1%Upwind_result%upwind_meanU)) THEN - ALLOCATE(b1(SIZE(u_out%Upwind_result%upwind_meanU,1))) - ALLOCATE(c1(SIZE(u_out%Upwind_result%upwind_meanU,1))) - b1 = -(u1%Upwind_result%upwind_meanU - u2%Upwind_result%upwind_meanU)/t(2) - u_out%Upwind_result%upwind_meanU = u1%Upwind_result%upwind_meanU + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%Upwind_result%upwind_meanU,1),UBOUND(u_out%Upwind_result%upwind_meanU,1) + b = -(u1%Upwind_result%upwind_meanU(i1) - u2%Upwind_result%upwind_meanU(i1)) + u_out%Upwind_result%upwind_meanU(i1) = u1%Upwind_result%upwind_meanU(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ALLOCATED(u_out%Upwind_result%upwind_TI) .AND. ALLOCATED(u1%Upwind_result%upwind_TI)) THEN - ALLOCATE(b1(SIZE(u_out%Upwind_result%upwind_TI,1))) - ALLOCATE(c1(SIZE(u_out%Upwind_result%upwind_TI,1))) - b1 = -(u1%Upwind_result%upwind_TI - u2%Upwind_result%upwind_TI)/t(2) - u_out%Upwind_result%upwind_TI = u1%Upwind_result%upwind_TI + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%Upwind_result%upwind_TI,1),UBOUND(u_out%Upwind_result%upwind_TI,1) + b = -(u1%Upwind_result%upwind_TI(i1) - u2%Upwind_result%upwind_TI(i1)) + u_out%Upwind_result%upwind_TI(i1) = u1%Upwind_result%upwind_TI(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ALLOCATED(u_out%Upwind_result%upwind_small_TI) .AND. ALLOCATED(u1%Upwind_result%upwind_small_TI)) THEN - ALLOCATE(b1(SIZE(u_out%Upwind_result%upwind_small_TI,1))) - ALLOCATE(c1(SIZE(u_out%Upwind_result%upwind_small_TI,1))) - b1 = -(u1%Upwind_result%upwind_small_TI - u2%Upwind_result%upwind_small_TI)/t(2) - u_out%Upwind_result%upwind_small_TI = u1%Upwind_result%upwind_small_TI + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%Upwind_result%upwind_small_TI,1),UBOUND(u_out%Upwind_result%upwind_small_TI,1) + b = -(u1%Upwind_result%upwind_small_TI(i1) - u2%Upwind_result%upwind_small_TI(i1)) + u_out%Upwind_result%upwind_small_TI(i1) = u1%Upwind_result%upwind_small_TI(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ALLOCATED(u_out%Upwind_result%upwind_smoothWake) .AND. ALLOCATED(u1%Upwind_result%upwind_smoothWake)) THEN - ALLOCATE(b2(SIZE(u_out%Upwind_result%upwind_smoothWake,1),SIZE(u_out%Upwind_result%upwind_smoothWake,2) )) - ALLOCATE(c2(SIZE(u_out%Upwind_result%upwind_smoothWake,1),SIZE(u_out%Upwind_result%upwind_smoothWake,2) )) - b2 = -(u1%Upwind_result%upwind_smoothWake - u2%Upwind_result%upwind_smoothWake)/t(2) - u_out%Upwind_result%upwind_smoothWake = u1%Upwind_result%upwind_smoothWake + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%Upwind_result%upwind_smoothWake,2),UBOUND(u_out%Upwind_result%upwind_smoothWake,2) + DO i1 = LBOUND(u_out%Upwind_result%upwind_smoothWake,1),UBOUND(u_out%Upwind_result%upwind_smoothWake,1) + b = -(u1%Upwind_result%upwind_smoothWake(i1,i2) - u2%Upwind_result%upwind_smoothWake(i1,i2)) + u_out%Upwind_result%upwind_smoothWake(i1,i2) = u1%Upwind_result%upwind_smoothWake(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated IF (ALLOCATED(u_out%Upwind_result%velocity_aerodyn) .AND. ALLOCATED(u1%Upwind_result%velocity_aerodyn)) THEN - ALLOCATE(b1(SIZE(u_out%Upwind_result%velocity_aerodyn,1))) - ALLOCATE(c1(SIZE(u_out%Upwind_result%velocity_aerodyn,1))) - b1 = -(u1%Upwind_result%velocity_aerodyn - u2%Upwind_result%velocity_aerodyn)/t(2) - u_out%Upwind_result%velocity_aerodyn = u1%Upwind_result%velocity_aerodyn + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%Upwind_result%velocity_aerodyn,1),UBOUND(u_out%Upwind_result%velocity_aerodyn,1) + b = -(u1%Upwind_result%velocity_aerodyn(i1) - u2%Upwind_result%velocity_aerodyn(i1)) + u_out%Upwind_result%velocity_aerodyn(i1) = u1%Upwind_result%velocity_aerodyn(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ALLOCATED(u_out%Upwind_result%TI_downstream) .AND. ALLOCATED(u1%Upwind_result%TI_downstream)) THEN - ALLOCATE(b1(SIZE(u_out%Upwind_result%TI_downstream,1))) - ALLOCATE(c1(SIZE(u_out%Upwind_result%TI_downstream,1))) - b1 = -(u1%Upwind_result%TI_downstream - u2%Upwind_result%TI_downstream)/t(2) - u_out%Upwind_result%TI_downstream = u1%Upwind_result%TI_downstream + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%Upwind_result%TI_downstream,1),UBOUND(u_out%Upwind_result%TI_downstream,1) + b = -(u1%Upwind_result%TI_downstream(i1) - u2%Upwind_result%TI_downstream(i1)) + u_out%Upwind_result%TI_downstream(i1) = u1%Upwind_result%TI_downstream(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ALLOCATED(u_out%Upwind_result%small_scale_TI_downstream) .AND. ALLOCATED(u1%Upwind_result%small_scale_TI_downstream)) THEN - ALLOCATE(b1(SIZE(u_out%Upwind_result%small_scale_TI_downstream,1))) - ALLOCATE(c1(SIZE(u_out%Upwind_result%small_scale_TI_downstream,1))) - b1 = -(u1%Upwind_result%small_scale_TI_downstream - u2%Upwind_result%small_scale_TI_downstream)/t(2) - u_out%Upwind_result%small_scale_TI_downstream = u1%Upwind_result%small_scale_TI_downstream + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%Upwind_result%small_scale_TI_downstream,1),UBOUND(u_out%Upwind_result%small_scale_TI_downstream,1) + b = -(u1%Upwind_result%small_scale_TI_downstream(i1) - u2%Upwind_result%small_scale_TI_downstream(i1)) + u_out%Upwind_result%small_scale_TI_downstream(i1) = u1%Upwind_result%small_scale_TI_downstream(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ALLOCATED(u_out%Upwind_result%smoothed_velocity_array) .AND. ALLOCATED(u1%Upwind_result%smoothed_velocity_array)) THEN - ALLOCATE(b2(SIZE(u_out%Upwind_result%smoothed_velocity_array,1),SIZE(u_out%Upwind_result%smoothed_velocity_array,2) )) - ALLOCATE(c2(SIZE(u_out%Upwind_result%smoothed_velocity_array,1),SIZE(u_out%Upwind_result%smoothed_velocity_array,2) )) - b2 = -(u1%Upwind_result%smoothed_velocity_array - u2%Upwind_result%smoothed_velocity_array)/t(2) - u_out%Upwind_result%smoothed_velocity_array = u1%Upwind_result%smoothed_velocity_array + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%Upwind_result%smoothed_velocity_array,2),UBOUND(u_out%Upwind_result%smoothed_velocity_array,2) + DO i1 = LBOUND(u_out%Upwind_result%smoothed_velocity_array,1),UBOUND(u_out%Upwind_result%smoothed_velocity_array,1) + b = -(u1%Upwind_result%smoothed_velocity_array(i1,i2) - u2%Upwind_result%smoothed_velocity_array(i1,i2)) + u_out%Upwind_result%smoothed_velocity_array(i1,i2) = u1%Upwind_result%smoothed_velocity_array(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated IF (ALLOCATED(u_out%Upwind_result%vel_matrix) .AND. ALLOCATED(u1%Upwind_result%vel_matrix)) THEN - ALLOCATE(b3(SIZE(u_out%Upwind_result%vel_matrix,1),SIZE(u_out%Upwind_result%vel_matrix,2), & - SIZE(u_out%Upwind_result%vel_matrix,3) )) - ALLOCATE(c3(SIZE(u_out%Upwind_result%vel_matrix,1),SIZE(u_out%Upwind_result%vel_matrix,2), & - SIZE(u_out%Upwind_result%vel_matrix,3) )) - b3 = -(u1%Upwind_result%vel_matrix - u2%Upwind_result%vel_matrix)/t(2) - u_out%Upwind_result%vel_matrix = u1%Upwind_result%vel_matrix + b3 * t_out - DEALLOCATE(b3) - DEALLOCATE(c3) + DO i3 = LBOUND(u_out%Upwind_result%vel_matrix,3),UBOUND(u_out%Upwind_result%vel_matrix,3) + DO i2 = LBOUND(u_out%Upwind_result%vel_matrix,2),UBOUND(u_out%Upwind_result%vel_matrix,2) + DO i1 = LBOUND(u_out%Upwind_result%vel_matrix,1),UBOUND(u_out%Upwind_result%vel_matrix,1) + b = -(u1%Upwind_result%vel_matrix(i1,i2,i3) - u2%Upwind_result%vel_matrix(i1,i2,i3)) + u_out%Upwind_result%vel_matrix(i1,i2,i3) = u1%Upwind_result%vel_matrix(i1,i2,i3) + b * ScaleFactor + END DO + END DO + END DO END IF ! check if allocated CALL InflowWind_Input_ExtrapInterp1( u1%IfW, u2%IfW, tin, u_out%IfW, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) @@ -9631,19 +9393,20 @@ SUBROUTINE DWM_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Err REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: b3 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: c3 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:,:) :: b4 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:,:) :: c4 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'DWM_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts + INTEGER :: i04 ! dim4 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + INTEGER :: i3 ! dim3 counter variable for arrays + INTEGER :: i4 ! dim4 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -9662,108 +9425,100 @@ SUBROUTINE DWM_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) IF (ALLOCATED(u_out%Upwind_result%upwind_U) .AND. ALLOCATED(u1%Upwind_result%upwind_U)) THEN - ALLOCATE(b2(SIZE(u_out%Upwind_result%upwind_U,1),SIZE(u_out%Upwind_result%upwind_U,2) )) - ALLOCATE(c2(SIZE(u_out%Upwind_result%upwind_U,1),SIZE(u_out%Upwind_result%upwind_U,2) )) - b2 = (t(3)**2*(u1%Upwind_result%upwind_U - u2%Upwind_result%upwind_U) + t(2)**2*(-u1%Upwind_result%upwind_U + u3%Upwind_result%upwind_U))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%Upwind_result%upwind_U + t(3)*u2%Upwind_result%upwind_U - t(2)*u3%Upwind_result%upwind_U ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Upwind_result%upwind_U = u1%Upwind_result%upwind_U + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%Upwind_result%upwind_U,2),UBOUND(u_out%Upwind_result%upwind_U,2) + DO i1 = LBOUND(u_out%Upwind_result%upwind_U,1),UBOUND(u_out%Upwind_result%upwind_U,1) + b = (t(3)**2*(u1%Upwind_result%upwind_U(i1,i2) - u2%Upwind_result%upwind_U(i1,i2)) + t(2)**2*(-u1%Upwind_result%upwind_U(i1,i2) + u3%Upwind_result%upwind_U(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%Upwind_result%upwind_U(i1,i2) + t(3)*u2%Upwind_result%upwind_U(i1,i2) - t(2)*u3%Upwind_result%upwind_U(i1,i2) ) * scaleFactor + u_out%Upwind_result%upwind_U(i1,i2) = u1%Upwind_result%upwind_U(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated IF (ALLOCATED(u_out%Upwind_result%upwind_wakecenter) .AND. ALLOCATED(u1%Upwind_result%upwind_wakecenter)) THEN - ALLOCATE(b4(SIZE(u_out%Upwind_result%upwind_wakecenter,1),SIZE(u_out%Upwind_result%upwind_wakecenter,2), & - SIZE(u_out%Upwind_result%upwind_wakecenter,3),SIZE(u_out%Upwind_result%upwind_wakecenter,4) )) - ALLOCATE(c4(SIZE(u_out%Upwind_result%upwind_wakecenter,1),SIZE(u_out%Upwind_result%upwind_wakecenter,2), & - SIZE(u_out%Upwind_result%upwind_wakecenter,3),SIZE(u_out%Upwind_result%upwind_wakecenter,4) )) - b4 = (t(3)**2*(u1%Upwind_result%upwind_wakecenter - u2%Upwind_result%upwind_wakecenter) + t(2)**2*(-u1%Upwind_result%upwind_wakecenter + u3%Upwind_result%upwind_wakecenter))/(t(2)*t(3)*(t(2) - t(3))) - c4 = ( (t(2)-t(3))*u1%Upwind_result%upwind_wakecenter + t(3)*u2%Upwind_result%upwind_wakecenter - t(2)*u3%Upwind_result%upwind_wakecenter ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Upwind_result%upwind_wakecenter = u1%Upwind_result%upwind_wakecenter + b4 * t_out + c4 * t_out**2 - DEALLOCATE(b4) - DEALLOCATE(c4) + DO i4 = LBOUND(u_out%Upwind_result%upwind_wakecenter,4),UBOUND(u_out%Upwind_result%upwind_wakecenter,4) + DO i3 = LBOUND(u_out%Upwind_result%upwind_wakecenter,3),UBOUND(u_out%Upwind_result%upwind_wakecenter,3) + DO i2 = LBOUND(u_out%Upwind_result%upwind_wakecenter,2),UBOUND(u_out%Upwind_result%upwind_wakecenter,2) + DO i1 = LBOUND(u_out%Upwind_result%upwind_wakecenter,1),UBOUND(u_out%Upwind_result%upwind_wakecenter,1) + b = (t(3)**2*(u1%Upwind_result%upwind_wakecenter(i1,i2,i3,i4) - u2%Upwind_result%upwind_wakecenter(i1,i2,i3,i4)) + t(2)**2*(-u1%Upwind_result%upwind_wakecenter(i1,i2,i3,i4) + u3%Upwind_result%upwind_wakecenter(i1,i2,i3,i4)))* scaleFactor + c = ( (t(2)-t(3))*u1%Upwind_result%upwind_wakecenter(i1,i2,i3,i4) + t(3)*u2%Upwind_result%upwind_wakecenter(i1,i2,i3,i4) - t(2)*u3%Upwind_result%upwind_wakecenter(i1,i2,i3,i4) ) * scaleFactor + u_out%Upwind_result%upwind_wakecenter(i1,i2,i3,i4) = u1%Upwind_result%upwind_wakecenter(i1,i2,i3,i4) + b + c * t_out + END DO + END DO + END DO + END DO END IF ! check if allocated IF (ALLOCATED(u_out%Upwind_result%upwind_meanU) .AND. ALLOCATED(u1%Upwind_result%upwind_meanU)) THEN - ALLOCATE(b1(SIZE(u_out%Upwind_result%upwind_meanU,1))) - ALLOCATE(c1(SIZE(u_out%Upwind_result%upwind_meanU,1))) - b1 = (t(3)**2*(u1%Upwind_result%upwind_meanU - u2%Upwind_result%upwind_meanU) + t(2)**2*(-u1%Upwind_result%upwind_meanU + u3%Upwind_result%upwind_meanU))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%Upwind_result%upwind_meanU + t(3)*u2%Upwind_result%upwind_meanU - t(2)*u3%Upwind_result%upwind_meanU ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Upwind_result%upwind_meanU = u1%Upwind_result%upwind_meanU + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%Upwind_result%upwind_meanU,1),UBOUND(u_out%Upwind_result%upwind_meanU,1) + b = (t(3)**2*(u1%Upwind_result%upwind_meanU(i1) - u2%Upwind_result%upwind_meanU(i1)) + t(2)**2*(-u1%Upwind_result%upwind_meanU(i1) + u3%Upwind_result%upwind_meanU(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%Upwind_result%upwind_meanU(i1) + t(3)*u2%Upwind_result%upwind_meanU(i1) - t(2)*u3%Upwind_result%upwind_meanU(i1) ) * scaleFactor + u_out%Upwind_result%upwind_meanU(i1) = u1%Upwind_result%upwind_meanU(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ALLOCATED(u_out%Upwind_result%upwind_TI) .AND. ALLOCATED(u1%Upwind_result%upwind_TI)) THEN - ALLOCATE(b1(SIZE(u_out%Upwind_result%upwind_TI,1))) - ALLOCATE(c1(SIZE(u_out%Upwind_result%upwind_TI,1))) - b1 = (t(3)**2*(u1%Upwind_result%upwind_TI - u2%Upwind_result%upwind_TI) + t(2)**2*(-u1%Upwind_result%upwind_TI + u3%Upwind_result%upwind_TI))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%Upwind_result%upwind_TI + t(3)*u2%Upwind_result%upwind_TI - t(2)*u3%Upwind_result%upwind_TI ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Upwind_result%upwind_TI = u1%Upwind_result%upwind_TI + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%Upwind_result%upwind_TI,1),UBOUND(u_out%Upwind_result%upwind_TI,1) + b = (t(3)**2*(u1%Upwind_result%upwind_TI(i1) - u2%Upwind_result%upwind_TI(i1)) + t(2)**2*(-u1%Upwind_result%upwind_TI(i1) + u3%Upwind_result%upwind_TI(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%Upwind_result%upwind_TI(i1) + t(3)*u2%Upwind_result%upwind_TI(i1) - t(2)*u3%Upwind_result%upwind_TI(i1) ) * scaleFactor + u_out%Upwind_result%upwind_TI(i1) = u1%Upwind_result%upwind_TI(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ALLOCATED(u_out%Upwind_result%upwind_small_TI) .AND. ALLOCATED(u1%Upwind_result%upwind_small_TI)) THEN - ALLOCATE(b1(SIZE(u_out%Upwind_result%upwind_small_TI,1))) - ALLOCATE(c1(SIZE(u_out%Upwind_result%upwind_small_TI,1))) - b1 = (t(3)**2*(u1%Upwind_result%upwind_small_TI - u2%Upwind_result%upwind_small_TI) + t(2)**2*(-u1%Upwind_result%upwind_small_TI + u3%Upwind_result%upwind_small_TI))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%Upwind_result%upwind_small_TI + t(3)*u2%Upwind_result%upwind_small_TI - t(2)*u3%Upwind_result%upwind_small_TI ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Upwind_result%upwind_small_TI = u1%Upwind_result%upwind_small_TI + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%Upwind_result%upwind_small_TI,1),UBOUND(u_out%Upwind_result%upwind_small_TI,1) + b = (t(3)**2*(u1%Upwind_result%upwind_small_TI(i1) - u2%Upwind_result%upwind_small_TI(i1)) + t(2)**2*(-u1%Upwind_result%upwind_small_TI(i1) + u3%Upwind_result%upwind_small_TI(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%Upwind_result%upwind_small_TI(i1) + t(3)*u2%Upwind_result%upwind_small_TI(i1) - t(2)*u3%Upwind_result%upwind_small_TI(i1) ) * scaleFactor + u_out%Upwind_result%upwind_small_TI(i1) = u1%Upwind_result%upwind_small_TI(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ALLOCATED(u_out%Upwind_result%upwind_smoothWake) .AND. ALLOCATED(u1%Upwind_result%upwind_smoothWake)) THEN - ALLOCATE(b2(SIZE(u_out%Upwind_result%upwind_smoothWake,1),SIZE(u_out%Upwind_result%upwind_smoothWake,2) )) - ALLOCATE(c2(SIZE(u_out%Upwind_result%upwind_smoothWake,1),SIZE(u_out%Upwind_result%upwind_smoothWake,2) )) - b2 = (t(3)**2*(u1%Upwind_result%upwind_smoothWake - u2%Upwind_result%upwind_smoothWake) + t(2)**2*(-u1%Upwind_result%upwind_smoothWake + u3%Upwind_result%upwind_smoothWake))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%Upwind_result%upwind_smoothWake + t(3)*u2%Upwind_result%upwind_smoothWake - t(2)*u3%Upwind_result%upwind_smoothWake ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Upwind_result%upwind_smoothWake = u1%Upwind_result%upwind_smoothWake + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%Upwind_result%upwind_smoothWake,2),UBOUND(u_out%Upwind_result%upwind_smoothWake,2) + DO i1 = LBOUND(u_out%Upwind_result%upwind_smoothWake,1),UBOUND(u_out%Upwind_result%upwind_smoothWake,1) + b = (t(3)**2*(u1%Upwind_result%upwind_smoothWake(i1,i2) - u2%Upwind_result%upwind_smoothWake(i1,i2)) + t(2)**2*(-u1%Upwind_result%upwind_smoothWake(i1,i2) + u3%Upwind_result%upwind_smoothWake(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%Upwind_result%upwind_smoothWake(i1,i2) + t(3)*u2%Upwind_result%upwind_smoothWake(i1,i2) - t(2)*u3%Upwind_result%upwind_smoothWake(i1,i2) ) * scaleFactor + u_out%Upwind_result%upwind_smoothWake(i1,i2) = u1%Upwind_result%upwind_smoothWake(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated IF (ALLOCATED(u_out%Upwind_result%velocity_aerodyn) .AND. ALLOCATED(u1%Upwind_result%velocity_aerodyn)) THEN - ALLOCATE(b1(SIZE(u_out%Upwind_result%velocity_aerodyn,1))) - ALLOCATE(c1(SIZE(u_out%Upwind_result%velocity_aerodyn,1))) - b1 = (t(3)**2*(u1%Upwind_result%velocity_aerodyn - u2%Upwind_result%velocity_aerodyn) + t(2)**2*(-u1%Upwind_result%velocity_aerodyn + u3%Upwind_result%velocity_aerodyn))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%Upwind_result%velocity_aerodyn + t(3)*u2%Upwind_result%velocity_aerodyn - t(2)*u3%Upwind_result%velocity_aerodyn ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Upwind_result%velocity_aerodyn = u1%Upwind_result%velocity_aerodyn + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%Upwind_result%velocity_aerodyn,1),UBOUND(u_out%Upwind_result%velocity_aerodyn,1) + b = (t(3)**2*(u1%Upwind_result%velocity_aerodyn(i1) - u2%Upwind_result%velocity_aerodyn(i1)) + t(2)**2*(-u1%Upwind_result%velocity_aerodyn(i1) + u3%Upwind_result%velocity_aerodyn(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%Upwind_result%velocity_aerodyn(i1) + t(3)*u2%Upwind_result%velocity_aerodyn(i1) - t(2)*u3%Upwind_result%velocity_aerodyn(i1) ) * scaleFactor + u_out%Upwind_result%velocity_aerodyn(i1) = u1%Upwind_result%velocity_aerodyn(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ALLOCATED(u_out%Upwind_result%TI_downstream) .AND. ALLOCATED(u1%Upwind_result%TI_downstream)) THEN - ALLOCATE(b1(SIZE(u_out%Upwind_result%TI_downstream,1))) - ALLOCATE(c1(SIZE(u_out%Upwind_result%TI_downstream,1))) - b1 = (t(3)**2*(u1%Upwind_result%TI_downstream - u2%Upwind_result%TI_downstream) + t(2)**2*(-u1%Upwind_result%TI_downstream + u3%Upwind_result%TI_downstream))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%Upwind_result%TI_downstream + t(3)*u2%Upwind_result%TI_downstream - t(2)*u3%Upwind_result%TI_downstream ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Upwind_result%TI_downstream = u1%Upwind_result%TI_downstream + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%Upwind_result%TI_downstream,1),UBOUND(u_out%Upwind_result%TI_downstream,1) + b = (t(3)**2*(u1%Upwind_result%TI_downstream(i1) - u2%Upwind_result%TI_downstream(i1)) + t(2)**2*(-u1%Upwind_result%TI_downstream(i1) + u3%Upwind_result%TI_downstream(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%Upwind_result%TI_downstream(i1) + t(3)*u2%Upwind_result%TI_downstream(i1) - t(2)*u3%Upwind_result%TI_downstream(i1) ) * scaleFactor + u_out%Upwind_result%TI_downstream(i1) = u1%Upwind_result%TI_downstream(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ALLOCATED(u_out%Upwind_result%small_scale_TI_downstream) .AND. ALLOCATED(u1%Upwind_result%small_scale_TI_downstream)) THEN - ALLOCATE(b1(SIZE(u_out%Upwind_result%small_scale_TI_downstream,1))) - ALLOCATE(c1(SIZE(u_out%Upwind_result%small_scale_TI_downstream,1))) - b1 = (t(3)**2*(u1%Upwind_result%small_scale_TI_downstream - u2%Upwind_result%small_scale_TI_downstream) + t(2)**2*(-u1%Upwind_result%small_scale_TI_downstream + u3%Upwind_result%small_scale_TI_downstream))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%Upwind_result%small_scale_TI_downstream + t(3)*u2%Upwind_result%small_scale_TI_downstream - t(2)*u3%Upwind_result%small_scale_TI_downstream ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Upwind_result%small_scale_TI_downstream = u1%Upwind_result%small_scale_TI_downstream + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%Upwind_result%small_scale_TI_downstream,1),UBOUND(u_out%Upwind_result%small_scale_TI_downstream,1) + b = (t(3)**2*(u1%Upwind_result%small_scale_TI_downstream(i1) - u2%Upwind_result%small_scale_TI_downstream(i1)) + t(2)**2*(-u1%Upwind_result%small_scale_TI_downstream(i1) + u3%Upwind_result%small_scale_TI_downstream(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%Upwind_result%small_scale_TI_downstream(i1) + t(3)*u2%Upwind_result%small_scale_TI_downstream(i1) - t(2)*u3%Upwind_result%small_scale_TI_downstream(i1) ) * scaleFactor + u_out%Upwind_result%small_scale_TI_downstream(i1) = u1%Upwind_result%small_scale_TI_downstream(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ALLOCATED(u_out%Upwind_result%smoothed_velocity_array) .AND. ALLOCATED(u1%Upwind_result%smoothed_velocity_array)) THEN - ALLOCATE(b2(SIZE(u_out%Upwind_result%smoothed_velocity_array,1),SIZE(u_out%Upwind_result%smoothed_velocity_array,2) )) - ALLOCATE(c2(SIZE(u_out%Upwind_result%smoothed_velocity_array,1),SIZE(u_out%Upwind_result%smoothed_velocity_array,2) )) - b2 = (t(3)**2*(u1%Upwind_result%smoothed_velocity_array - u2%Upwind_result%smoothed_velocity_array) + t(2)**2*(-u1%Upwind_result%smoothed_velocity_array + u3%Upwind_result%smoothed_velocity_array))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%Upwind_result%smoothed_velocity_array + t(3)*u2%Upwind_result%smoothed_velocity_array - t(2)*u3%Upwind_result%smoothed_velocity_array ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Upwind_result%smoothed_velocity_array = u1%Upwind_result%smoothed_velocity_array + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%Upwind_result%smoothed_velocity_array,2),UBOUND(u_out%Upwind_result%smoothed_velocity_array,2) + DO i1 = LBOUND(u_out%Upwind_result%smoothed_velocity_array,1),UBOUND(u_out%Upwind_result%smoothed_velocity_array,1) + b = (t(3)**2*(u1%Upwind_result%smoothed_velocity_array(i1,i2) - u2%Upwind_result%smoothed_velocity_array(i1,i2)) + t(2)**2*(-u1%Upwind_result%smoothed_velocity_array(i1,i2) + u3%Upwind_result%smoothed_velocity_array(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%Upwind_result%smoothed_velocity_array(i1,i2) + t(3)*u2%Upwind_result%smoothed_velocity_array(i1,i2) - t(2)*u3%Upwind_result%smoothed_velocity_array(i1,i2) ) * scaleFactor + u_out%Upwind_result%smoothed_velocity_array(i1,i2) = u1%Upwind_result%smoothed_velocity_array(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated IF (ALLOCATED(u_out%Upwind_result%vel_matrix) .AND. ALLOCATED(u1%Upwind_result%vel_matrix)) THEN - ALLOCATE(b3(SIZE(u_out%Upwind_result%vel_matrix,1),SIZE(u_out%Upwind_result%vel_matrix,2), & - SIZE(u_out%Upwind_result%vel_matrix,3) )) - ALLOCATE(c3(SIZE(u_out%Upwind_result%vel_matrix,1),SIZE(u_out%Upwind_result%vel_matrix,2), & - SIZE(u_out%Upwind_result%vel_matrix,3) )) - b3 = (t(3)**2*(u1%Upwind_result%vel_matrix - u2%Upwind_result%vel_matrix) + t(2)**2*(-u1%Upwind_result%vel_matrix + u3%Upwind_result%vel_matrix))/(t(2)*t(3)*(t(2) - t(3))) - c3 = ( (t(2)-t(3))*u1%Upwind_result%vel_matrix + t(3)*u2%Upwind_result%vel_matrix - t(2)*u3%Upwind_result%vel_matrix ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Upwind_result%vel_matrix = u1%Upwind_result%vel_matrix + b3 * t_out + c3 * t_out**2 - DEALLOCATE(b3) - DEALLOCATE(c3) + DO i3 = LBOUND(u_out%Upwind_result%vel_matrix,3),UBOUND(u_out%Upwind_result%vel_matrix,3) + DO i2 = LBOUND(u_out%Upwind_result%vel_matrix,2),UBOUND(u_out%Upwind_result%vel_matrix,2) + DO i1 = LBOUND(u_out%Upwind_result%vel_matrix,1),UBOUND(u_out%Upwind_result%vel_matrix,1) + b = (t(3)**2*(u1%Upwind_result%vel_matrix(i1,i2,i3) - u2%Upwind_result%vel_matrix(i1,i2,i3)) + t(2)**2*(-u1%Upwind_result%vel_matrix(i1,i2,i3) + u3%Upwind_result%vel_matrix(i1,i2,i3)))* scaleFactor + c = ( (t(2)-t(3))*u1%Upwind_result%vel_matrix(i1,i2,i3) + t(3)*u2%Upwind_result%vel_matrix(i1,i2,i3) - t(2)*u3%Upwind_result%vel_matrix(i1,i2,i3) ) * scaleFactor + u_out%Upwind_result%vel_matrix(i1,i2,i3) = u1%Upwind_result%vel_matrix(i1,i2,i3) + b + c * t_out + END DO + END DO + END DO END IF ! check if allocated CALL InflowWind_Input_ExtrapInterp2( u1%IfW, u2%IfW, u3%IfW, tin, u_out%IfW, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) @@ -9844,16 +9599,16 @@ SUBROUTINE DWM_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'DWM_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: b3 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: c3 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + INTEGER :: i3 ! dim3 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -9866,88 +9621,80 @@ SUBROUTINE DWM_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) IF (ALLOCATED(y_out%turbine_thrust_force) .AND. ALLOCATED(y1%turbine_thrust_force)) THEN - ALLOCATE(b1(SIZE(y_out%turbine_thrust_force,1))) - ALLOCATE(c1(SIZE(y_out%turbine_thrust_force,1))) - b1 = -(y1%turbine_thrust_force - y2%turbine_thrust_force)/t(2) - y_out%turbine_thrust_force = y1%turbine_thrust_force + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%turbine_thrust_force,1),UBOUND(y_out%turbine_thrust_force,1) + b = -(y1%turbine_thrust_force(i1) - y2%turbine_thrust_force(i1)) + y_out%turbine_thrust_force(i1) = y1%turbine_thrust_force(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ALLOCATED(y_out%induction_factor) .AND. ALLOCATED(y1%induction_factor)) THEN - ALLOCATE(b1(SIZE(y_out%induction_factor,1))) - ALLOCATE(c1(SIZE(y_out%induction_factor,1))) - b1 = -(y1%induction_factor - y2%induction_factor)/t(2) - y_out%induction_factor = y1%induction_factor + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%induction_factor,1),UBOUND(y_out%induction_factor,1) + b = -(y1%induction_factor(i1) - y2%induction_factor(i1)) + y_out%induction_factor(i1) = y1%induction_factor(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ALLOCATED(y_out%r_initial) .AND. ALLOCATED(y1%r_initial)) THEN - ALLOCATE(b1(SIZE(y_out%r_initial,1))) - ALLOCATE(c1(SIZE(y_out%r_initial,1))) - b1 = -(y1%r_initial - y2%r_initial)/t(2) - y_out%r_initial = y1%r_initial + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%r_initial,1),UBOUND(y_out%r_initial,1) + b = -(y1%r_initial(i1) - y2%r_initial(i1)) + y_out%r_initial(i1) = y1%r_initial(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ALLOCATED(y_out%U_initial) .AND. ALLOCATED(y1%U_initial)) THEN - ALLOCATE(b1(SIZE(y_out%U_initial,1))) - ALLOCATE(c1(SIZE(y_out%U_initial,1))) - b1 = -(y1%U_initial - y2%U_initial)/t(2) - y_out%U_initial = y1%U_initial + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%U_initial,1),UBOUND(y_out%U_initial,1) + b = -(y1%U_initial(i1) - y2%U_initial(i1)) + y_out%U_initial(i1) = y1%U_initial(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ALLOCATED(y_out%Mean_FFWS_array) .AND. ALLOCATED(y1%Mean_FFWS_array)) THEN - ALLOCATE(b1(SIZE(y_out%Mean_FFWS_array,1))) - ALLOCATE(c1(SIZE(y_out%Mean_FFWS_array,1))) - b1 = -(y1%Mean_FFWS_array - y2%Mean_FFWS_array)/t(2) - y_out%Mean_FFWS_array = y1%Mean_FFWS_array + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%Mean_FFWS_array,1),UBOUND(y_out%Mean_FFWS_array,1) + b = -(y1%Mean_FFWS_array(i1) - y2%Mean_FFWS_array(i1)) + y_out%Mean_FFWS_array(i1) = y1%Mean_FFWS_array(i1) + b * ScaleFactor + END DO END IF ! check if allocated - b0 = -(y1%Mean_FFWS - y2%Mean_FFWS)/t(2) - y_out%Mean_FFWS = y1%Mean_FFWS + b0 * t_out - b0 = -(y1%TI - y2%TI)/t(2) - y_out%TI = y1%TI + b0 * t_out - b0 = -(y1%TI_downstream - y2%TI_downstream)/t(2) - y_out%TI_downstream = y1%TI_downstream + b0 * t_out + b = -(y1%Mean_FFWS - y2%Mean_FFWS) + y_out%Mean_FFWS = y1%Mean_FFWS + b * ScaleFactor + b = -(y1%TI - y2%TI) + y_out%TI = y1%TI + b * ScaleFactor + b = -(y1%TI_downstream - y2%TI_downstream) + y_out%TI_downstream = y1%TI_downstream + b * ScaleFactor IF (ALLOCATED(y_out%wake_u) .AND. ALLOCATED(y1%wake_u)) THEN - ALLOCATE(b2(SIZE(y_out%wake_u,1),SIZE(y_out%wake_u,2) )) - ALLOCATE(c2(SIZE(y_out%wake_u,1),SIZE(y_out%wake_u,2) )) - b2 = -(y1%wake_u - y2%wake_u)/t(2) - y_out%wake_u = y1%wake_u + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%wake_u,2),UBOUND(y_out%wake_u,2) + DO i1 = LBOUND(y_out%wake_u,1),UBOUND(y_out%wake_u,1) + b = -(y1%wake_u(i1,i2) - y2%wake_u(i1,i2)) + y_out%wake_u(i1,i2) = y1%wake_u(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%wake_position) .AND. ALLOCATED(y1%wake_position)) THEN - ALLOCATE(b3(SIZE(y_out%wake_position,1),SIZE(y_out%wake_position,2), & - SIZE(y_out%wake_position,3) )) - ALLOCATE(c3(SIZE(y_out%wake_position,1),SIZE(y_out%wake_position,2), & - SIZE(y_out%wake_position,3) )) - b3 = -(y1%wake_position - y2%wake_position)/t(2) - y_out%wake_position = y1%wake_position + b3 * t_out - DEALLOCATE(b3) - DEALLOCATE(c3) + DO i3 = LBOUND(y_out%wake_position,3),UBOUND(y_out%wake_position,3) + DO i2 = LBOUND(y_out%wake_position,2),UBOUND(y_out%wake_position,2) + DO i1 = LBOUND(y_out%wake_position,1),UBOUND(y_out%wake_position,1) + b = -(y1%wake_position(i1,i2,i3) - y2%wake_position(i1,i2,i3)) + y_out%wake_position(i1,i2,i3) = y1%wake_position(i1,i2,i3) + b * ScaleFactor + END DO + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%smoothed_velocity_array) .AND. ALLOCATED(y1%smoothed_velocity_array)) THEN - ALLOCATE(b2(SIZE(y_out%smoothed_velocity_array,1),SIZE(y_out%smoothed_velocity_array,2) )) - ALLOCATE(c2(SIZE(y_out%smoothed_velocity_array,1),SIZE(y_out%smoothed_velocity_array,2) )) - b2 = -(y1%smoothed_velocity_array - y2%smoothed_velocity_array)/t(2) - y_out%smoothed_velocity_array = y1%smoothed_velocity_array + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%smoothed_velocity_array,2),UBOUND(y_out%smoothed_velocity_array,2) + DO i1 = LBOUND(y_out%smoothed_velocity_array,1),UBOUND(y_out%smoothed_velocity_array,1) + b = -(y1%smoothed_velocity_array(i1,i2) - y2%smoothed_velocity_array(i1,i2)) + y_out%smoothed_velocity_array(i1,i2) = y1%smoothed_velocity_array(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated - b0 = -(y1%AtmUscale - y2%AtmUscale)/t(2) - y_out%AtmUscale = y1%AtmUscale + b0 * t_out - b0 = -(y1%du_dz_ABL - y2%du_dz_ABL)/t(2) - y_out%du_dz_ABL = y1%du_dz_ABL + b0 * t_out - b0 = -(y1%total_SDgenpwr - y2%total_SDgenpwr)/t(2) - y_out%total_SDgenpwr = y1%total_SDgenpwr + b0 * t_out - b0 = -(y1%mean_SDgenpwr - y2%mean_SDgenpwr)/t(2) - y_out%mean_SDgenpwr = y1%mean_SDgenpwr + b0 * t_out - b0 = -(y1%avg_ct - y2%avg_ct)/t(2) - y_out%avg_ct = y1%avg_ct + b0 * t_out + b = -(y1%AtmUscale - y2%AtmUscale) + y_out%AtmUscale = y1%AtmUscale + b * ScaleFactor + b = -(y1%du_dz_ABL - y2%du_dz_ABL) + y_out%du_dz_ABL = y1%du_dz_ABL + b * ScaleFactor + b = -(y1%total_SDgenpwr - y2%total_SDgenpwr) + y_out%total_SDgenpwr = y1%total_SDgenpwr + b * ScaleFactor + b = -(y1%mean_SDgenpwr - y2%mean_SDgenpwr) + y_out%mean_SDgenpwr = y1%mean_SDgenpwr + b * ScaleFactor + b = -(y1%avg_ct - y2%avg_ct) + y_out%avg_ct = y1%avg_ct + b * ScaleFactor CALL InflowWind_Output_ExtrapInterp1( y1%IfW, y2%IfW, tin, y_out%IfW, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE DWM_Output_ExtrapInterp1 @@ -9979,17 +9726,18 @@ SUBROUTINE DWM_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Er REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: b3 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: c3 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'DWM_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + INTEGER :: i3 ! dim3 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -10008,104 +9756,96 @@ SUBROUTINE DWM_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) IF (ALLOCATED(y_out%turbine_thrust_force) .AND. ALLOCATED(y1%turbine_thrust_force)) THEN - ALLOCATE(b1(SIZE(y_out%turbine_thrust_force,1))) - ALLOCATE(c1(SIZE(y_out%turbine_thrust_force,1))) - b1 = (t(3)**2*(y1%turbine_thrust_force - y2%turbine_thrust_force) + t(2)**2*(-y1%turbine_thrust_force + y3%turbine_thrust_force))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%turbine_thrust_force + t(3)*y2%turbine_thrust_force - t(2)*y3%turbine_thrust_force ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%turbine_thrust_force = y1%turbine_thrust_force + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%turbine_thrust_force,1),UBOUND(y_out%turbine_thrust_force,1) + b = (t(3)**2*(y1%turbine_thrust_force(i1) - y2%turbine_thrust_force(i1)) + t(2)**2*(-y1%turbine_thrust_force(i1) + y3%turbine_thrust_force(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%turbine_thrust_force(i1) + t(3)*y2%turbine_thrust_force(i1) - t(2)*y3%turbine_thrust_force(i1) ) * scaleFactor + y_out%turbine_thrust_force(i1) = y1%turbine_thrust_force(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ALLOCATED(y_out%induction_factor) .AND. ALLOCATED(y1%induction_factor)) THEN - ALLOCATE(b1(SIZE(y_out%induction_factor,1))) - ALLOCATE(c1(SIZE(y_out%induction_factor,1))) - b1 = (t(3)**2*(y1%induction_factor - y2%induction_factor) + t(2)**2*(-y1%induction_factor + y3%induction_factor))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%induction_factor + t(3)*y2%induction_factor - t(2)*y3%induction_factor ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%induction_factor = y1%induction_factor + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%induction_factor,1),UBOUND(y_out%induction_factor,1) + b = (t(3)**2*(y1%induction_factor(i1) - y2%induction_factor(i1)) + t(2)**2*(-y1%induction_factor(i1) + y3%induction_factor(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%induction_factor(i1) + t(3)*y2%induction_factor(i1) - t(2)*y3%induction_factor(i1) ) * scaleFactor + y_out%induction_factor(i1) = y1%induction_factor(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ALLOCATED(y_out%r_initial) .AND. ALLOCATED(y1%r_initial)) THEN - ALLOCATE(b1(SIZE(y_out%r_initial,1))) - ALLOCATE(c1(SIZE(y_out%r_initial,1))) - b1 = (t(3)**2*(y1%r_initial - y2%r_initial) + t(2)**2*(-y1%r_initial + y3%r_initial))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%r_initial + t(3)*y2%r_initial - t(2)*y3%r_initial ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%r_initial = y1%r_initial + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%r_initial,1),UBOUND(y_out%r_initial,1) + b = (t(3)**2*(y1%r_initial(i1) - y2%r_initial(i1)) + t(2)**2*(-y1%r_initial(i1) + y3%r_initial(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%r_initial(i1) + t(3)*y2%r_initial(i1) - t(2)*y3%r_initial(i1) ) * scaleFactor + y_out%r_initial(i1) = y1%r_initial(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ALLOCATED(y_out%U_initial) .AND. ALLOCATED(y1%U_initial)) THEN - ALLOCATE(b1(SIZE(y_out%U_initial,1))) - ALLOCATE(c1(SIZE(y_out%U_initial,1))) - b1 = (t(3)**2*(y1%U_initial - y2%U_initial) + t(2)**2*(-y1%U_initial + y3%U_initial))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%U_initial + t(3)*y2%U_initial - t(2)*y3%U_initial ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%U_initial = y1%U_initial + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%U_initial,1),UBOUND(y_out%U_initial,1) + b = (t(3)**2*(y1%U_initial(i1) - y2%U_initial(i1)) + t(2)**2*(-y1%U_initial(i1) + y3%U_initial(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%U_initial(i1) + t(3)*y2%U_initial(i1) - t(2)*y3%U_initial(i1) ) * scaleFactor + y_out%U_initial(i1) = y1%U_initial(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ALLOCATED(y_out%Mean_FFWS_array) .AND. ALLOCATED(y1%Mean_FFWS_array)) THEN - ALLOCATE(b1(SIZE(y_out%Mean_FFWS_array,1))) - ALLOCATE(c1(SIZE(y_out%Mean_FFWS_array,1))) - b1 = (t(3)**2*(y1%Mean_FFWS_array - y2%Mean_FFWS_array) + t(2)**2*(-y1%Mean_FFWS_array + y3%Mean_FFWS_array))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%Mean_FFWS_array + t(3)*y2%Mean_FFWS_array - t(2)*y3%Mean_FFWS_array ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Mean_FFWS_array = y1%Mean_FFWS_array + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%Mean_FFWS_array,1),UBOUND(y_out%Mean_FFWS_array,1) + b = (t(3)**2*(y1%Mean_FFWS_array(i1) - y2%Mean_FFWS_array(i1)) + t(2)**2*(-y1%Mean_FFWS_array(i1) + y3%Mean_FFWS_array(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%Mean_FFWS_array(i1) + t(3)*y2%Mean_FFWS_array(i1) - t(2)*y3%Mean_FFWS_array(i1) ) * scaleFactor + y_out%Mean_FFWS_array(i1) = y1%Mean_FFWS_array(i1) + b + c * t_out + END DO END IF ! check if allocated - b0 = (t(3)**2*(y1%Mean_FFWS - y2%Mean_FFWS) + t(2)**2*(-y1%Mean_FFWS + y3%Mean_FFWS))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%Mean_FFWS + t(3)*y2%Mean_FFWS - t(2)*y3%Mean_FFWS ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Mean_FFWS = y1%Mean_FFWS + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%TI - y2%TI) + t(2)**2*(-y1%TI + y3%TI))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%TI + t(3)*y2%TI - t(2)*y3%TI ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%TI = y1%TI + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%TI_downstream - y2%TI_downstream) + t(2)**2*(-y1%TI_downstream + y3%TI_downstream))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%TI_downstream + t(3)*y2%TI_downstream - t(2)*y3%TI_downstream ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%TI_downstream = y1%TI_downstream + b0 * t_out + c0 * t_out**2 + b = (t(3)**2*(y1%Mean_FFWS - y2%Mean_FFWS) + t(2)**2*(-y1%Mean_FFWS + y3%Mean_FFWS))* scaleFactor + c = ( (t(2)-t(3))*y1%Mean_FFWS + t(3)*y2%Mean_FFWS - t(2)*y3%Mean_FFWS ) * scaleFactor + y_out%Mean_FFWS = y1%Mean_FFWS + b + c * t_out + b = (t(3)**2*(y1%TI - y2%TI) + t(2)**2*(-y1%TI + y3%TI))* scaleFactor + c = ( (t(2)-t(3))*y1%TI + t(3)*y2%TI - t(2)*y3%TI ) * scaleFactor + y_out%TI = y1%TI + b + c * t_out + b = (t(3)**2*(y1%TI_downstream - y2%TI_downstream) + t(2)**2*(-y1%TI_downstream + y3%TI_downstream))* scaleFactor + c = ( (t(2)-t(3))*y1%TI_downstream + t(3)*y2%TI_downstream - t(2)*y3%TI_downstream ) * scaleFactor + y_out%TI_downstream = y1%TI_downstream + b + c * t_out IF (ALLOCATED(y_out%wake_u) .AND. ALLOCATED(y1%wake_u)) THEN - ALLOCATE(b2(SIZE(y_out%wake_u,1),SIZE(y_out%wake_u,2) )) - ALLOCATE(c2(SIZE(y_out%wake_u,1),SIZE(y_out%wake_u,2) )) - b2 = (t(3)**2*(y1%wake_u - y2%wake_u) + t(2)**2*(-y1%wake_u + y3%wake_u))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*y1%wake_u + t(3)*y2%wake_u - t(2)*y3%wake_u ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%wake_u = y1%wake_u + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%wake_u,2),UBOUND(y_out%wake_u,2) + DO i1 = LBOUND(y_out%wake_u,1),UBOUND(y_out%wake_u,1) + b = (t(3)**2*(y1%wake_u(i1,i2) - y2%wake_u(i1,i2)) + t(2)**2*(-y1%wake_u(i1,i2) + y3%wake_u(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*y1%wake_u(i1,i2) + t(3)*y2%wake_u(i1,i2) - t(2)*y3%wake_u(i1,i2) ) * scaleFactor + y_out%wake_u(i1,i2) = y1%wake_u(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%wake_position) .AND. ALLOCATED(y1%wake_position)) THEN - ALLOCATE(b3(SIZE(y_out%wake_position,1),SIZE(y_out%wake_position,2), & - SIZE(y_out%wake_position,3) )) - ALLOCATE(c3(SIZE(y_out%wake_position,1),SIZE(y_out%wake_position,2), & - SIZE(y_out%wake_position,3) )) - b3 = (t(3)**2*(y1%wake_position - y2%wake_position) + t(2)**2*(-y1%wake_position + y3%wake_position))/(t(2)*t(3)*(t(2) - t(3))) - c3 = ( (t(2)-t(3))*y1%wake_position + t(3)*y2%wake_position - t(2)*y3%wake_position ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%wake_position = y1%wake_position + b3 * t_out + c3 * t_out**2 - DEALLOCATE(b3) - DEALLOCATE(c3) + DO i3 = LBOUND(y_out%wake_position,3),UBOUND(y_out%wake_position,3) + DO i2 = LBOUND(y_out%wake_position,2),UBOUND(y_out%wake_position,2) + DO i1 = LBOUND(y_out%wake_position,1),UBOUND(y_out%wake_position,1) + b = (t(3)**2*(y1%wake_position(i1,i2,i3) - y2%wake_position(i1,i2,i3)) + t(2)**2*(-y1%wake_position(i1,i2,i3) + y3%wake_position(i1,i2,i3)))* scaleFactor + c = ( (t(2)-t(3))*y1%wake_position(i1,i2,i3) + t(3)*y2%wake_position(i1,i2,i3) - t(2)*y3%wake_position(i1,i2,i3) ) * scaleFactor + y_out%wake_position(i1,i2,i3) = y1%wake_position(i1,i2,i3) + b + c * t_out + END DO + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%smoothed_velocity_array) .AND. ALLOCATED(y1%smoothed_velocity_array)) THEN - ALLOCATE(b2(SIZE(y_out%smoothed_velocity_array,1),SIZE(y_out%smoothed_velocity_array,2) )) - ALLOCATE(c2(SIZE(y_out%smoothed_velocity_array,1),SIZE(y_out%smoothed_velocity_array,2) )) - b2 = (t(3)**2*(y1%smoothed_velocity_array - y2%smoothed_velocity_array) + t(2)**2*(-y1%smoothed_velocity_array + y3%smoothed_velocity_array))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*y1%smoothed_velocity_array + t(3)*y2%smoothed_velocity_array - t(2)*y3%smoothed_velocity_array ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%smoothed_velocity_array = y1%smoothed_velocity_array + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%smoothed_velocity_array,2),UBOUND(y_out%smoothed_velocity_array,2) + DO i1 = LBOUND(y_out%smoothed_velocity_array,1),UBOUND(y_out%smoothed_velocity_array,1) + b = (t(3)**2*(y1%smoothed_velocity_array(i1,i2) - y2%smoothed_velocity_array(i1,i2)) + t(2)**2*(-y1%smoothed_velocity_array(i1,i2) + y3%smoothed_velocity_array(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*y1%smoothed_velocity_array(i1,i2) + t(3)*y2%smoothed_velocity_array(i1,i2) - t(2)*y3%smoothed_velocity_array(i1,i2) ) * scaleFactor + y_out%smoothed_velocity_array(i1,i2) = y1%smoothed_velocity_array(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated - b0 = (t(3)**2*(y1%AtmUscale - y2%AtmUscale) + t(2)**2*(-y1%AtmUscale + y3%AtmUscale))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%AtmUscale + t(3)*y2%AtmUscale - t(2)*y3%AtmUscale ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%AtmUscale = y1%AtmUscale + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%du_dz_ABL - y2%du_dz_ABL) + t(2)**2*(-y1%du_dz_ABL + y3%du_dz_ABL))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%du_dz_ABL + t(3)*y2%du_dz_ABL - t(2)*y3%du_dz_ABL ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%du_dz_ABL = y1%du_dz_ABL + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%total_SDgenpwr - y2%total_SDgenpwr) + t(2)**2*(-y1%total_SDgenpwr + y3%total_SDgenpwr))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%total_SDgenpwr + t(3)*y2%total_SDgenpwr - t(2)*y3%total_SDgenpwr ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%total_SDgenpwr = y1%total_SDgenpwr + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%mean_SDgenpwr - y2%mean_SDgenpwr) + t(2)**2*(-y1%mean_SDgenpwr + y3%mean_SDgenpwr))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%mean_SDgenpwr + t(3)*y2%mean_SDgenpwr - t(2)*y3%mean_SDgenpwr ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%mean_SDgenpwr = y1%mean_SDgenpwr + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%avg_ct - y2%avg_ct) + t(2)**2*(-y1%avg_ct + y3%avg_ct))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%avg_ct + t(3)*y2%avg_ct - t(2)*y3%avg_ct ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%avg_ct = y1%avg_ct + b0 * t_out + c0 * t_out**2 + b = (t(3)**2*(y1%AtmUscale - y2%AtmUscale) + t(2)**2*(-y1%AtmUscale + y3%AtmUscale))* scaleFactor + c = ( (t(2)-t(3))*y1%AtmUscale + t(3)*y2%AtmUscale - t(2)*y3%AtmUscale ) * scaleFactor + y_out%AtmUscale = y1%AtmUscale + b + c * t_out + b = (t(3)**2*(y1%du_dz_ABL - y2%du_dz_ABL) + t(2)**2*(-y1%du_dz_ABL + y3%du_dz_ABL))* scaleFactor + c = ( (t(2)-t(3))*y1%du_dz_ABL + t(3)*y2%du_dz_ABL - t(2)*y3%du_dz_ABL ) * scaleFactor + y_out%du_dz_ABL = y1%du_dz_ABL + b + c * t_out + b = (t(3)**2*(y1%total_SDgenpwr - y2%total_SDgenpwr) + t(2)**2*(-y1%total_SDgenpwr + y3%total_SDgenpwr))* scaleFactor + c = ( (t(2)-t(3))*y1%total_SDgenpwr + t(3)*y2%total_SDgenpwr - t(2)*y3%total_SDgenpwr ) * scaleFactor + y_out%total_SDgenpwr = y1%total_SDgenpwr + b + c * t_out + b = (t(3)**2*(y1%mean_SDgenpwr - y2%mean_SDgenpwr) + t(2)**2*(-y1%mean_SDgenpwr + y3%mean_SDgenpwr))* scaleFactor + c = ( (t(2)-t(3))*y1%mean_SDgenpwr + t(3)*y2%mean_SDgenpwr - t(2)*y3%mean_SDgenpwr ) * scaleFactor + y_out%mean_SDgenpwr = y1%mean_SDgenpwr + b + c * t_out + b = (t(3)**2*(y1%avg_ct - y2%avg_ct) + t(2)**2*(-y1%avg_ct + y3%avg_ct))* scaleFactor + c = ( (t(2)-t(3))*y1%avg_ct + t(3)*y2%avg_ct - t(2)*y3%avg_ct ) * scaleFactor + y_out%avg_ct = y1%avg_ct + b + c * t_out CALL InflowWind_Output_ExtrapInterp2( y1%IfW, y2%IfW, y3%IfW, tin, y_out%IfW, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE DWM_Output_ExtrapInterp2 diff --git a/modules/beamdyn/CMakeLists.txt b/modules/beamdyn/CMakeLists.txt index 28eee6db3e..dae656b088 100644 --- a/modules/beamdyn/CMakeLists.txt +++ b/modules/beamdyn/CMakeLists.txt @@ -21,6 +21,7 @@ endif() set(BD_SOURCES src/BeamDyn.f90 src/BeamDyn_IO.f90 + src/BeamDyn_BldNdOuts_IO.f90 src/BeamDyn_Subs.f90 src/BeamDyn_Types.f90 ) diff --git a/modules/beamdyn/src/BeamDyn.f90 b/modules/beamdyn/src/BeamDyn.f90 index e32b4eca4f..7af5c177a2 100644 --- a/modules/beamdyn/src/BeamDyn.f90 +++ b/modules/beamdyn/src/BeamDyn.f90 @@ -17,6 +17,7 @@ !********************************************************************************************************************************** MODULE BeamDyn + USE BeamDyn_BldNdOuts_IO USE BeamDyn_IO USE BeamDyn_Subs !USE NWTC_LAPACK inherited from BeamDyn_Subs and BeamDyn_IO @@ -156,7 +157,7 @@ SUBROUTINE BD_Init( InitInp, u, p, x, xd, z, OtherState, y, MiscVar, Interval, I ENDIF ! compute physical distances to set positions of p%uuN0 (FE GLL_Nodes) (depends on p%SP_Coef): - call InitializeNodalLocations(InputFileData, p, GLL_nodes, ErrStat2,ErrMsg2) + call InitializeNodalLocations(InputFileData, p, GLL_nodes, InitOut, ErrStat2,ErrMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) if (ErrStat >= AbortErrLev) then call cleanup() @@ -493,11 +494,12 @@ END SUBROUTINE Cleanup end subroutine InitializeMassStiffnessMatrices !----------------------------------------------------------------------------------------------------------------------------------- -!> This subroutine computes the positions and rotations stored in p%uuN0 (output GLL nodes). -subroutine InitializeNodalLocations(InputFileData,p,GLL_nodes,ErrStat, ErrMsg) +!> This subroutine computes the positions and rotations stored in p%uuN0 (output GLL nodes) and p%QuadPt (input quadrature nodes). p%QPtN must be already set. +subroutine InitializeNodalLocations(InputFileData,p,GLL_nodes,InitOut,ErrStat, ErrMsg) type(BD_InputFile), intent(in ) :: InputFileData !< data from the input file type(BD_ParameterType), intent(inout) :: p !< Parameters REAL(BDKi), INTENT(IN ) :: GLL_nodes(:) !< GLL_nodes(p%nodes_per_elem): location of the (p%nodes_per_elem) p%GLL points + type(BD_InitOutputType), intent(inout) :: InitOut !< initialization output type (for setting z_coordinate variable) integer(IntKi), intent( out) :: ErrStat !< Error status of the operation character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None @@ -507,10 +509,8 @@ subroutine InitializeNodalLocations(InputFileData,p,GLL_nodes,ErrStat, ErrMsg) ! local variables INTEGER(IntKi) :: i ! do-loop counter INTEGER(IntKi) :: j ! do-loop counter - INTEGER(IntKi) :: idx_qp !< index of current quadrature point in loop INTEGER(IntKi) :: member_first_kp INTEGER(IntKi) :: member_last_kp - INTEGER(IntKi) :: temp_id2 REAL(BDKi) :: eta REAL(BDKi) :: temp_POS(3) REAL(BDKi) :: temp_CRV(3) @@ -551,6 +551,63 @@ subroutine InitializeNodalLocations(InputFileData,p,GLL_nodes,ErrStat, ErrMsg) ENDDO + + !!------------------------------------------------- + !! InitOut%z_coordinate contains the z coordinate (in meters) along the blade and will be used for naming output channels + !!------------------------------------------------- + ! + ! + !SELECT CASE(p%BldMotionNodeLoc) + !CASE (BD_MESH_FE) + ! CALL AllocAry( InitOut%z_coordinate, p%nodes_per_elem*p%elem_total,'InitOut%z_coordinate',ErrStat2,ErrMsg2) ! same size as y%BldMotion%NNodes + ! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! if (ErrStat2 >= AbortErrLev) return + ! + ! member_first_kp = 1 !first key point on member (element) + ! DO i=1,p%elem_total + ! + ! member_last_kp = member_first_kp + InputFileData%kp_member(i) - 1 !last key point of member (element) + ! DO j=1,p%nodes_per_elem + ! + ! eta = (GLL_nodes(j) + 1.0_BDKi)/2.0_BDKi ! relative location where we are on the member (element), in range [0,1] + ! InitOut%z_coordinate( (i-1)*p%nodes_per_elem + j ) = Find_InitZ(InputFileData%kp_coordinate, member_first_kp, member_last_kp, eta) + ! ENDDO + ! + ! ! set for next element: + ! member_first_kp = member_last_kp + ! + ! ENDDO + ! + ! + !CASE (BD_MESH_QP) + ! CALL AllocAry( InitOut%z_coordinate, size(p%NdIndx),'InitOut%z_coordinate',ErrStat2,ErrMsg2) ! same size as y%BldMotion%NNodes + ! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! if (ErrStat2 >= AbortErrLev) return + ! + ! member_first_kp = 1 + ! + ! DO i=1,p%elem_total + ! member_last_kp = member_first_kp + InputFileData%kp_member(i) - 1 + ! + ! DO idx_qp=1,p%nqp(i) + ! eta = (p%QPtN(idx_qp,i) + 1.0_BDKi)/2.0_BDKi ! translate quadrature points in [-1,1] to eta in [0,1] + ! temp_ID = SUM(p%nqp(0:i-1)) + idx_qp + p%qp_indx_offset - (i - 1)*p%qp_overlap_offset ! indx_offset=0, overlap_offset=1 for trap + ! InitOut%z_coordinate( temp_ID ) = Find_InitZ(InputFileData%kp_coordinate, member_first_kp, member_last_kp, eta) + ! ENDDO + ! + ! ! set for next element: + ! member_first_kp = member_last_kp + ! ENDDO + ! + ! IF (p%quadrature .EQ. GAUSS_QUADRATURE) THEN + ! InitOut%z_coordinate( 1 ) = InputFileData%kp_coordinate(1,3) + ! InitOut%z_coordinate( size(InitOut%z_coordinate) ) = InputFileData%kp_coordinate(InputFileData%kp_total,3) + ! ENDIF + ! + !END SELECT + + return + end subroutine InitializeNodalLocations !----------------------------------------------------------------------------------------------------------------------------------- !> This routine calculates the contributions of the integral of shape functions outboard of an FE node. These weighting values are @@ -722,7 +779,7 @@ END SUBROUTINE BD_InitShpDerJaco !> This subroutine initializes data in the InitOut type, which is returned to the glue code. subroutine SetInitOut(p, InitOut, ErrStat, ErrMsg) - type(BD_InitOutputType), intent( out) :: InitOut !< output data + type(BD_InitOutputType), intent(inout) :: InitOut !< output data (we've already set InitOut%z_coordinate) type(BD_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 @@ -741,11 +798,12 @@ subroutine SetInitOut(p, InitOut, ErrStat, ErrMsg) errStat = ErrID_None errMsg = "" + ! p%BldNd_BlOutNd contains the list of nodes we are outputting. At each node there are BldNd_NumOuts output channels. - call AllocAry( InitOut%WriteOutputHdr, p%numOuts, 'WriteOutputHdr', errStat2, errMsg2 ) + call AllocAry( InitOut%WriteOutputHdr, p%numOuts + p%BldNd_TotNumOuts, 'WriteOutputHdr', errStat2, errMsg2 ) call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) - call AllocAry( InitOut%WriteOutputUnt, p%numOuts, 'WriteOutputUnt', errStat2, errMsg2 ) + call AllocAry( InitOut%WriteOutputUnt, p%numOuts + p%BldNd_TotNumOuts, 'WriteOutputUnt', errStat2, errMsg2 ) call SetErrStat( errStat2, errMsg2, errStat, errMsg, RoutineName ) if (ErrStat >= AbortErrLev) return @@ -756,12 +814,17 @@ subroutine SetInitOut(p, InitOut, ErrStat, ErrMsg) InitOut%Ver = BeamDyn_Ver + + ! Set the info in WriteOutputHdr and WriteOutputUnt for BldNd sections. + CALL BldNdOuts_InitOut( InitOut, p, ErrStat2, ErrMsg2 ) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + end subroutine SetInitOut !----------------------------------------------------------------------------------------------------------------------------------- !> This subroutine allocates and initializes most (not all) of the parameters used in BeamDyn. subroutine SetParameters(InitInp, InputFileData, p, ErrStat, ErrMsg) type(BD_InitInputType), intent(in ) :: InitInp !< Input data for initialization routine - type(BD_InputFile), intent(in ) :: InputFileData !< data from the input file + type(BD_InputFile), intent(inout) :: InputFileData !< data from the input file [we may need to shift the keypoint to match a MK matrix eta for trap multi-element] type(BD_ParameterType), intent(inout) :: p !< Parameters ! intent(out) only because it changes p%NdIndx integer(IntKi), intent( out) :: ErrStat !< Error status of the operation character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None @@ -786,7 +849,8 @@ subroutine SetParameters(InitInp, InputFileData, p, ErrStat, ErrMsg) p%GlbPos = InitInp%GlbPos - ! Global rotation tensor + ! Global rotation tensor. What comes from the driver may not be a properly formed + ! DCM (may have roundoff), so recalculate it from the extracted WM parameters. p%GlbRot = TRANSPOSE(InitInp%GlbRot) ! matrix that now transfers from local to global (FAST's DCMs convert from global to local) CALL BD_CrvExtractCrv(p%GlbRot,p%Glb_crv, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -900,7 +964,7 @@ subroutine SetParameters(InitInp, InputFileData, p, ErrStat, ErrMsg) ! Set start and end node index for each elements !............................................... - ! Store the node number for first and last node in element + ! Store the node number for first and last FE node in element ! p%node_total = p%elem_total*(p%nodes_per_elem-1) + 1 is the number of GLL nodes total for the beam ! --> This assumes that the first node of element 2 is the same as the last node of element 1. ! Some subroutines are looking at a single element, in which case the values stored in p%nodes_elem_idx @@ -915,6 +979,8 @@ subroutine SetParameters(InitInp, InputFileData, p, ErrStat, ErrMsg) CASE (BD_MESH_FE) CALL AllocAry(p%NdIndx,p%node_total,'p%NdIndx',ErrStat2,ErrMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AllocAry(p%NdIndxInverse,p%elem_total*p%nodes_per_elem,'p%NdIndxInverse',ErrStat2,ErrMsg2) ! same size as y%BldMotion%NNodes + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL AllocAry(p%OutNd2NdElem,2,p%node_total,'p%OutNd2NdElem',ErrStat2,ErrMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) if (ErrStat >= AbortErrLev) return @@ -923,18 +989,24 @@ subroutine SetParameters(InitInp, InputFileData, p, ErrStat, ErrMsg) p%OutNd2NdElem(:,1) = 1 ! note this is an array indx = 2 DO i=1,p%elem_total + p%NdIndxInverse((i-1)*p%nodes_per_elem + 1) = indx-1 ! Index into BldMotion mesh (to number the nodes for output without using collocated nodes) + DO j=2,p%nodes_per_elem ! GLL nodes overlap at element end points; we will skip the first node of each element (after the first one) p%NdIndx(indx) = (i-1)*p%nodes_per_elem + j ! Index into BldMotion mesh (to number the nodes for output without using collocated nodes) + p%NdIndxInverse(p%NdIndx(indx)) = indx ! Index from BldMotion mesh (to number of unique nodes) p%OutNd2NdElem(1,indx) = j ! Node number. To go from an output node number to a node/elem pair p%OutNd2NdElem(2,indx) = i ! Element number. To go from an output node number to a node/elem pair indx = indx + 1 END DO ENDDO - + CASE (BD_MESH_QP) + IF (p%quadrature .EQ. GAUSS_QUADRATURE) THEN nUniqueQP = p%nqp*p%elem_total + 2*p%qp_indx_offset - + + CALL AllocAry(p%NdIndxInverse, nUniqueQP,'p%NdIndxInverse',ErrStat2,ErrMsg2) ! same size as y%BldMotion%NNodes, a sibling of u%DistrLoad + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL AllocAry(p%NdIndx, nUniqueQP,'p%NdIndx',ErrStat2,ErrMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL AllocAry(p%OutNd2NdElem,2,nUniqueQP,'p%OutNd2NdElem',ErrStat2,ErrMsg2) @@ -943,6 +1015,7 @@ subroutine SetParameters(InitInp, InputFileData, p, ErrStat, ErrMsg) DO i=1,nUniqueQP ! gauss quadrature doesn't have overlapping nodes p%NdIndx(i) = i + p%NdIndxInverse(i) = i END DO indx = 2 @@ -960,7 +1033,9 @@ subroutine SetParameters(InitInp, InputFileData, p, ErrStat, ErrMsg) ELSEIF(p%quadrature .EQ. TRAP_QUADRATURE) THEN ! at least one quadrature point associated with each blade station nUniqueQP = (p%nqp-1)*p%elem_total + 1 - + + CALL AllocAry(p%NdIndxInverse, nUniqueQP,'p%NdIndxInverse',ErrStat2,ErrMsg2) ! same size as y%BldMotion%NNodes, a sibling of u%DistrLoad + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL AllocAry(p%NdIndx, nUniqueQP,'p%NdIndx',ErrStat2,ErrMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL AllocAry(p%OutNd2NdElem,2,nUniqueQP,'p%OutNd2NdElem',ErrStat2,ErrMsg2) @@ -973,6 +1048,7 @@ subroutine SetParameters(InitInp, InputFileData, p, ErrStat, ErrMsg) DO i=1,p%elem_total DO j=2,p%nqp ! trap quadrature contains overlapping nodes at element end points; we will skip the first node of each element (after the first one) p%NdIndx(indx) = (i-1)*p%nqp + j ! Index into BldMotion mesh (to number the nodes for output without using collocated nodes) + p%NdIndxInverse(p%NdIndx(indx)) = indx ! Index from BldMotion mesh p%OutNd2NdElem(1,indx) = j ! Node number. To go from an output node number to a node/elem pair p%OutNd2NdElem(2,indx) = i ! Element number. To go from an output node number to a node/elem pair indx = indx + 1; @@ -1020,6 +1096,10 @@ subroutine SetParameters(InitInp, InputFileData, p, ErrStat, ErrMsg) if (ErrStat >= AbortErrLev) return + call BldNdOuts_SetParameters(InitInp, InputFileData, p, ErrStat2, ErrMsg2 ) ! requires p%BldNd_NumOuts, y%BldMotion + call setErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat >= AbortErrLev) return + end subroutine SetParameters !----------------------------------------------------------------------------------------------------------------------------------- !> this routine initializes the outputs, y, that are used in the BeamDyn interface for coupling in the FAST framework. @@ -1156,13 +1236,16 @@ subroutine Init_y( p, u, y, ErrStat, ErrMsg) CALL SetErrStat(ErrID_Fatal, "Invalid p%BldMotionNodeLoc.", ErrStat, ErrMsg, RoutineName ) END SELECT + y%BldMotion%RefNode = 1 !................................. ! y%WriteOutput (for writing columns to output file) !................................. - call AllocAry( y%WriteOutput, p%numOuts, 'WriteOutput', errStat2, errMsg2 ) + ! p%BldNd_BlOutNd contains the list of nodes we are outputting. + + call AllocAry( y%WriteOutput, p%numOuts + p%BldNd_TotNumOuts, 'WriteOutput', errStat2, errMsg2 ) call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) end subroutine Init_y @@ -1409,7 +1492,7 @@ subroutine Init_u( InitInp, p, u, ErrStat, ErrMsg ) CALL MeshCommit ( Mesh = u%DistrLoad & ,ErrStat = ErrStat2 & ,ErrMess = ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SetErrStat( ErrStat2, 'u%DistrLoad'//ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! initial guesses u%DistrLoad%Force = 0.0_ReKi @@ -1784,7 +1867,7 @@ END SUBROUTINE BD_UpdateStates !----------------------------------------------------------------------------------------------------------------------------------- !> Routine for computing outputs, used in both loose and tight coupling. -SUBROUTINE BD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) +SUBROUTINE BD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, NeedWriteOutput ) REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds TYPE(BD_InputType), INTENT(INOUT) :: u !< Inputs at t @@ -1798,6 +1881,7 @@ SUBROUTINE BD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) TYPE(BD_MiscVarType), INTENT(INOUT) :: m !< misc/optimization variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + LOGICAL, OPTIONAL, INTENT(IN ) :: NeedWriteOutput !< Flag to determine if WriteOutput values need to be calculated in this call TYPE(BD_ContinuousStateType) :: x_tmp TYPE(BD_OtherStateType) :: OtherState_tmp @@ -1807,13 +1891,20 @@ SUBROUTINE BD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) INTEGER(IntKi) :: ErrStat2 ! Temporary Error status CHARACTER(ErrMsgLen) :: ErrMsg2 ! Temporary Error message CHARACTER(*), PARAMETER :: RoutineName = 'BD_CalcOutput' + LOGICAL :: CalcWriteOutput - + ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" AllOuts = 0.0_ReKi + + if (present(NeedWriteOutput)) then + CalcWriteOutput = NeedWriteOutput + else + CalcWriteOutput = .true. ! by default, calculate WriteOutput unless told that we do not need it + end if ! Since x is passed in, but we need to update it, we must work with a copy. CALL BD_CopyContState(x, x_tmp, MESH_NEWCOPY, ErrStat2, ErrMsg2) @@ -1912,19 +2003,31 @@ SUBROUTINE BD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) ! compute RootMxr and RootMyr for ServoDyn and ! get values to output to file: !------------------------------------------------------- - call Calc_WriteOutput( p, AllOuts, y, m, ErrStat2, ErrMsg2 ) !uses m%u2 + call Calc_WriteOutput( p, AllOuts, y, m, ErrStat2, ErrMsg2, CalcWriteOutput ) !uses m%u2 CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) y%RootMxr = AllOuts( RootMxr ) y%RootMyr = AllOuts( RootMyr ) - !............................................................................................................................... - ! Place the selected output channels into the WriteOutput(:) array with the proper sign: - !............................................................................................................................... + if (CalcWriteOutput) then + !............................................................................................................................... + ! Place the selected output channels into the WriteOutput(:) array with the proper sign: + !............................................................................................................................... + + do i = 1,p%NumOuts ! Loop through all selected output channels + y%WriteOutput(i) = p%OutParam(i)%SignM * AllOuts( p%OutParam(i)%Indx ) + end do ! i - All selected output channels - do i = 1,p%NumOuts ! Loop through all selected output channels - y%WriteOutput(i) = p%OutParam(i)%SignM * AllOuts( p%OutParam(i)%Indx ) - end do ! i - All selected output channels + + IF( p%BldNd_NumOuts > 0 ) THEN + ! Put the values from the nodal outputs into the writeoutput array + y%WriteOutput(p%NumOuts+1:) = 0.0_ReKi + + ! Now we need to populate the blade node outputs here + call Calc_WriteBldNdOutput( p, m, y, ErrStat2, ErrMsg2 ) ! Call after normal writeoutput. Will just postpend data on here. + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ENDIF + end if call cleanup() @@ -2878,7 +2981,6 @@ SUBROUTINE BD_DissipativeForce( nelem, p, m,fact ) REAL(BDKi) :: b11(3,3) REAL(BDKi) :: b12(3,3) REAL(BDKi) :: alpha(3,3) - INTEGER(IntKi) :: i, j INTEGER(IntKi) :: idx_qp !< index of current quadrature point @@ -3508,7 +3610,6 @@ SUBROUTINE BD_Static(t,u,utimes,p,x,OtherState,m,ErrStat,ErrMsg) TYPE(BD_InputType) :: u_interp ! temporary copy of inputs, transferred to BD local system REAL(BDKi) :: ScaleFactor ! Factor for scaling applied loads at each step - INTEGER(IntKi) :: i INTEGER(IntKi) :: j ! Generic counters INTEGER(IntKi) :: piter REAL(BDKi) :: gravity_temp(3) @@ -3751,7 +3852,6 @@ SUBROUTINE BD_FD_Stat( x, gravity, p, m ) ! local variables INTEGER(IntKi) :: i INTEGER(IntKi) :: idx_dof - REAL(BDKi), allocatable :: RHS_m(:,:), RHS_p(:,:) CHARACTER(*), PARAMETER :: RoutineName = 'BD_FD_Stat' ! zero out the local matrices. @@ -6677,7 +6777,7 @@ SUBROUTINE BD_JacobianPConstrState( t, u, p, x, xd, z, OtherState, y, m, ErrStat END SUBROUTINE BD_JacobianPConstrState !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !> Routine to pack the data structures representing the operating points into arrays for linearization. -SUBROUTINE BD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op ) +SUBROUTINE BD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op, NeedLogMap ) REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(BD_InputType), INTENT(INOUT) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) @@ -6696,6 +6796,7 @@ SUBROUTINE BD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dx_op(:) !< values of first time derivatives of linearized continuous states REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states + LOGICAL, OPTIONAL, INTENT(IN ) :: NeedLogMap !< whether a y_op values should contain log maps instead of full orientation matrices INTEGER(IntKi) :: index, i, dof INTEGER(IntKi) :: nu @@ -6704,6 +6805,7 @@ SUBROUTINE BD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'BD_GetOP' LOGICAL :: FieldMask(FIELDMASK_SIZE) + LOGICAL :: ReturnLogMap TYPE(BD_ContinuousStateType) :: dx ! derivative of continuous states at operating point @@ -6740,10 +6842,15 @@ SUBROUTINE BD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, IF ( PRESENT( y_op ) ) THEN + if (present(NeedLogMap)) then + ReturnLogMap = NeedLogMap + else + ReturnLogMap = .false. + end if - ny = p%Jac_ny + y%BldMotion%NNodes * 6 ! Jac_ny has 3 orientation angles, but the OP needs the full 9 elements of the DCM (thus 6 more per node) - if (.not. allocated(y_op)) then + ny = p%Jac_ny + y%BldMotion%NNodes * 6 ! Jac_ny has 3 orientation angles, but the OP needs the full 9 elements of the DCM (thus 6 more per node) + call AllocAry(y_op, ny, 'y_op', ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if (ErrStat >= AbortErrLev) return @@ -6760,10 +6867,10 @@ SUBROUTINE BD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, FieldMask(MASKID_RotationVel) = .true. FieldMask(MASKID_TranslationAcc) = .true. FieldMask(MASKID_RotationAcc) = .true. - call PackMotionMesh(y%BldMotion, y_op, index, FieldMask=FieldMask) + call PackMotionMesh(y%BldMotion, y_op, index, FieldMask=FieldMask, UseLogMaps=ReturnLogMap) index = index - 1 - do i=1,p%NumOuts + do i=1,p%NumOuts + p%BldNd_TotNumOuts y_op(i+index) = y%WriteOutput(i) end do diff --git a/modules/beamdyn/src/BeamDyn_BldNdOuts_IO.f90 b/modules/beamdyn/src/BeamDyn_BldNdOuts_IO.f90 new file mode 100644 index 0000000000..0eb1c40681 --- /dev/null +++ b/modules/beamdyn/src/BeamDyn_BldNdOuts_IO.f90 @@ -0,0 +1,1493 @@ +! This module is an add on to BeamDyn to allow output of data at each blade node. +! +! Copyright (C) 2016-2017 Envision Energy USA, LTD +! +MODULE BeamDyn_BldNdOuts_IO + + USE NWTC_Library + USE NWTC_LAPACK + USE BeamDyn_Subs + USE BeamDyn_Types + + IMPLICIT NONE + + PRIVATE + + + ! Outstanding issues + ! 1. Currently nothing is added to the summary file. If we add some output there, some changes either in the BeamDyn + ! code (as distributed) will be needed, or changes here (reopen file and append). + + + PUBLIC :: BldNdOuts_InitOut + PUBLIC :: Calc_WriteBldNdOutput + PUBLIC :: BldNdOuts_SetParameters + + + + ! Parameters related to output length (number of characters allowed in the output data headers): + + INTEGER(IntKi), PARAMETER :: OutStrLenM1 = ChanLen-6 ! We are making these of the form B1Z###quantity, but note that the glue code adds the "B1" (turbine component) part + +! =================================================================================================== +! NOTE: The following lines of code were generated by a Matlab script called "Write_ChckOutLst.m" +! using the parameters listed in the "OutListParameters.xlsx" Excel file. Any changes to these +! lines should be modified in the Matlab script and/or Excel worksheet as necessary. +! =================================================================================================== +! This code was generated by Write_ChckOutLst.m at 12-Dec-2017 20:48:14. + + ! NOTES: + ! (1) These parameters are in the order stored in "OutListParameters.xlsx" + + + ! Sectional Loads: + + INTEGER(IntKi), PARAMETER :: BldNd_FxL = 1 + INTEGER(IntKi), PARAMETER :: BldNd_FyL = 2 + INTEGER(IntKi), PARAMETER :: BldNd_FzL = 3 + INTEGER(IntKi), PARAMETER :: BldNd_MxL = 4 + INTEGER(IntKi), PARAMETER :: BldNd_MyL = 5 + INTEGER(IntKi), PARAMETER :: BldNd_MzL = 6 + INTEGER(IntKi), PARAMETER :: BldNd_Fxr = 7 + INTEGER(IntKi), PARAMETER :: BldNd_Fyr = 8 + INTEGER(IntKi), PARAMETER :: BldNd_Fzr = 9 + INTEGER(IntKi), PARAMETER :: BldNd_Mxr = 10 + INTEGER(IntKi), PARAMETER :: BldNd_Myr = 11 + INTEGER(IntKi), PARAMETER :: BldNd_Mzr = 12 + + + ! Sectional Motions: + + INTEGER(IntKi), PARAMETER :: BldNd_TDxr = 13 + INTEGER(IntKi), PARAMETER :: BldNd_TDyr = 14 + INTEGER(IntKi), PARAMETER :: BldNd_TDzr = 15 + INTEGER(IntKi), PARAMETER :: BldNd_RDxr = 16 + INTEGER(IntKi), PARAMETER :: BldNd_RDyr = 17 + INTEGER(IntKi), PARAMETER :: BldNd_RDzr = 18 + INTEGER(IntKi), PARAMETER :: BldNd_AbsXg = 19 + INTEGER(IntKi), PARAMETER :: BldNd_AbsYg = 20 + INTEGER(IntKi), PARAMETER :: BldNd_AbsZg = 21 + INTEGER(IntKi), PARAMETER :: BldNd_AbsXr = 22 + INTEGER(IntKi), PARAMETER :: BldNd_AbsYr = 23 + INTEGER(IntKi), PARAMETER :: BldNd_AbsZr = 24 + INTEGER(IntKi), PARAMETER :: BldNd_TVxg = 25 + INTEGER(IntKi), PARAMETER :: BldNd_TVyg = 26 + INTEGER(IntKi), PARAMETER :: BldNd_TVzg = 27 + INTEGER(IntKi), PARAMETER :: BldNd_TVxl = 28 + INTEGER(IntKi), PARAMETER :: BldNd_TVyl = 29 + INTEGER(IntKi), PARAMETER :: BldNd_TVzl = 30 + INTEGER(IntKi), PARAMETER :: BldNd_TVxr = 31 + INTEGER(IntKi), PARAMETER :: BldNd_TVyr = 32 + INTEGER(IntKi), PARAMETER :: BldNd_TVzr = 33 + INTEGER(IntKi), PARAMETER :: BldNd_RVxg = 34 + INTEGER(IntKi), PARAMETER :: BldNd_RVyg = 35 + INTEGER(IntKi), PARAMETER :: BldNd_RVzg = 36 + INTEGER(IntKi), PARAMETER :: BldNd_RVxl = 37 + INTEGER(IntKi), PARAMETER :: BldNd_RVyl = 38 + INTEGER(IntKi), PARAMETER :: BldNd_RVzl = 39 + INTEGER(IntKi), PARAMETER :: BldNd_RVxr = 40 + INTEGER(IntKi), PARAMETER :: BldNd_RVyr = 41 + INTEGER(IntKi), PARAMETER :: BldNd_RVzr = 42 + INTEGER(IntKi), PARAMETER :: BldNd_TAxl = 43 + INTEGER(IntKi), PARAMETER :: BldNd_TAyl = 44 + INTEGER(IntKi), PARAMETER :: BldNd_TAzl = 45 + INTEGER(IntKi), PARAMETER :: BldNd_TAxr = 46 + INTEGER(IntKi), PARAMETER :: BldNd_TAyr = 47 + INTEGER(IntKi), PARAMETER :: BldNd_TAzr = 48 + INTEGER(IntKi), PARAMETER :: BldNd_RAxl = 49 + INTEGER(IntKi), PARAMETER :: BldNd_RAyl = 50 + INTEGER(IntKi), PARAMETER :: BldNd_RAzl = 51 + INTEGER(IntKi), PARAMETER :: BldNd_RAxr = 52 + INTEGER(IntKi), PARAMETER :: BldNd_RAyr = 53 + INTEGER(IntKi), PARAMETER :: BldNd_RAzr = 54 + + ! Applied Loads: + + INTEGER(IntKi), PARAMETER :: BldNd_PFxL = 55 + INTEGER(IntKi), PARAMETER :: BldNd_PFyL = 56 + INTEGER(IntKi), PARAMETER :: BldNd_PFzL = 57 + INTEGER(IntKi), PARAMETER :: BldNd_PMxL = 58 + INTEGER(IntKi), PARAMETER :: BldNd_PMyL = 59 + INTEGER(IntKi), PARAMETER :: BldNd_PMzL = 60 + INTEGER(IntKi), PARAMETER :: BldNd_DFxL = 61 + INTEGER(IntKi), PARAMETER :: BldNd_DFyL = 62 + INTEGER(IntKi), PARAMETER :: BldNd_DFzL = 63 + INTEGER(IntKi), PARAMETER :: BldNd_DMxL = 64 + INTEGER(IntKi), PARAMETER :: BldNd_DMyL = 65 + INTEGER(IntKi), PARAMETER :: BldNd_DMzL = 66 + INTEGER(IntKi), PARAMETER :: BldNd_DFxR = 67 + INTEGER(IntKi), PARAMETER :: BldNd_DFyR = 68 + INTEGER(IntKi), PARAMETER :: BldNd_DFzR = 69 + INTEGER(IntKi), PARAMETER :: BldNd_DMxR = 70 + INTEGER(IntKi), PARAMETER :: BldNd_DMyR = 71 + INTEGER(IntKi), PARAMETER :: BldNd_DMzR = 72 + + + ! Sectional Partial Loads (debugging): + + INTEGER(IntKi), PARAMETER :: BldNd_FFbxl = 73 + INTEGER(IntKi), PARAMETER :: BldNd_FFbyl = 74 + INTEGER(IntKi), PARAMETER :: BldNd_FFbzl = 75 + INTEGER(IntKi), PARAMETER :: BldNd_FFbxr = 76 + INTEGER(IntKi), PARAMETER :: BldNd_FFbyr = 77 + INTEGER(IntKi), PARAMETER :: BldNd_FFbzr = 78 + INTEGER(IntKi), PARAMETER :: BldNd_MFbxl = 79 + INTEGER(IntKi), PARAMETER :: BldNd_MFbyl = 80 + INTEGER(IntKi), PARAMETER :: BldNd_MFbzl = 81 + INTEGER(IntKi), PARAMETER :: BldNd_MFbxr = 82 + INTEGER(IntKi), PARAMETER :: BldNd_MFbyr = 83 + INTEGER(IntKi), PARAMETER :: BldNd_MFbzr = 84 + INTEGER(IntKi), PARAMETER :: BldNd_FFcxl = 85 + INTEGER(IntKi), PARAMETER :: BldNd_FFcyl = 86 + INTEGER(IntKi), PARAMETER :: BldNd_FFczl = 87 + INTEGER(IntKi), PARAMETER :: BldNd_FFcxr = 88 + INTEGER(IntKi), PARAMETER :: BldNd_FFcyr = 89 + INTEGER(IntKi), PARAMETER :: BldNd_FFczr = 90 + INTEGER(IntKi), PARAMETER :: BldNd_MFcxl = 91 + INTEGER(IntKi), PARAMETER :: BldNd_MFcyl = 92 + INTEGER(IntKi), PARAMETER :: BldNd_MFczl = 93 + INTEGER(IntKi), PARAMETER :: BldNd_MFcxr = 94 + INTEGER(IntKi), PARAMETER :: BldNd_MFcyr = 95 + INTEGER(IntKi), PARAMETER :: BldNd_MFczr = 96 + INTEGER(IntKi), PARAMETER :: BldNd_FFdxl = 97 + INTEGER(IntKi), PARAMETER :: BldNd_FFdyl = 98 + INTEGER(IntKi), PARAMETER :: BldNd_FFdzl = 99 + INTEGER(IntKi), PARAMETER :: BldNd_FFdxr = 100 + INTEGER(IntKi), PARAMETER :: BldNd_FFdyr = 101 + INTEGER(IntKi), PARAMETER :: BldNd_FFdzr = 102 + INTEGER(IntKi), PARAMETER :: BldNd_MFdxl = 103 + INTEGER(IntKi), PARAMETER :: BldNd_MFdyl = 104 + INTEGER(IntKi), PARAMETER :: BldNd_MFdzl = 105 + INTEGER(IntKi), PARAMETER :: BldNd_MFdxr = 106 + INTEGER(IntKi), PARAMETER :: BldNd_MFdyr = 107 + INTEGER(IntKi), PARAMETER :: BldNd_MFdzr = 108 + INTEGER(IntKi), PARAMETER :: BldNd_FFgxl = 109 + INTEGER(IntKi), PARAMETER :: BldNd_FFgyl = 110 + INTEGER(IntKi), PARAMETER :: BldNd_FFgzl = 111 + INTEGER(IntKi), PARAMETER :: BldNd_FFgxr = 112 + INTEGER(IntKi), PARAMETER :: BldNd_FFgyr = 113 + INTEGER(IntKi), PARAMETER :: BldNd_FFgzr = 114 + INTEGER(IntKi), PARAMETER :: BldNd_MFgxl = 115 + INTEGER(IntKi), PARAMETER :: BldNd_MFgyl = 116 + INTEGER(IntKi), PARAMETER :: BldNd_MFgzl = 117 + INTEGER(IntKi), PARAMETER :: BldNd_MFgxr = 118 + INTEGER(IntKi), PARAMETER :: BldNd_MFgyr = 119 + INTEGER(IntKi), PARAMETER :: BldNd_MFgzr = 120 + INTEGER(IntKi), PARAMETER :: BldNd_FFixl = 121 + INTEGER(IntKi), PARAMETER :: BldNd_FFiyl = 122 + INTEGER(IntKi), PARAMETER :: BldNd_FFizl = 123 + INTEGER(IntKi), PARAMETER :: BldNd_FFixr = 124 + INTEGER(IntKi), PARAMETER :: BldNd_FFiyr = 125 + INTEGER(IntKi), PARAMETER :: BldNd_FFizr = 126 + INTEGER(IntKi), PARAMETER :: BldNd_MFixl = 127 + INTEGER(IntKi), PARAMETER :: BldNd_MFiyl = 128 + INTEGER(IntKi), PARAMETER :: BldNd_MFizl = 129 + INTEGER(IntKi), PARAMETER :: BldNd_MFixr = 130 + INTEGER(IntKi), PARAMETER :: BldNd_MFiyr = 131 + INTEGER(IntKi), PARAMETER :: BldNd_MFizr = 132 + + ! The maximum number of output channels which can be output by the code. + INTEGER(IntKi), PARAMETER, PUBLIC :: BldNd_MaxOutPts = 132 + +!End of code generated by Matlab script +! =================================================================================================== + +CONTAINS +!---------------------------------------------------------------------------------------------------------------------------------- + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This subroutine populates the headers with the blade node outputs. The iteration cycle is blade:node:channel (channel iterated +!! fastest). If this iteration order is changed, it should be changed in the Calc_WriteBldNdOutput routine as well. +SUBROUTINE BldNdOuts_InitOut( InitOut, p, ErrStat, ErrMsg ) + + + TYPE(BD_InitOutputType), INTENT(INOUT) :: InitOut ! output data + TYPE(BD_ParameterType), INTENT(IN ) :: p ! The module parameters + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! The error status code + CHARACTER(*), INTENT( OUT) :: ErrMsg ! The error message, if an error occurred + + INTEGER(IntKi) :: ErrStat2 ! Error status code + INTEGER(IntKi) :: INDX ! Index count within WriteOutput + INTEGER(IntKi) :: IdxNode ! Counter to the blade node we ae on + INTEGER(IntKi) :: IdxChan ! Counter to the channel we are outputting. + CHARACTER(1) :: ChanPrefix ! Name prefix (B#_ -- note that the B# part is added in FAST, not here) + CHARACTER(4), ALLOCATABLE :: DistStr(:) ! Array of prefix (Z######y) + CHARACTER(3) :: TmpChar ! Temporary char array to hold the node digits (3 places only!!!!) + CHARACTER(*), PARAMETER :: RoutineName = ('BldNdOuts_InitOut') + + + ! Initialize some things + ErrMsg = '' + ErrStat = ErrID_None + + + IF ( p%BldNd_NumOuts == 0 ) THEN + return + ENDIF + + ! create the channel names using the z-coordinate of the beam in mm + ALLOCATE( DistStr(size(p%BldNd_BlOutNd)), STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + call SetErrStat(ErrID_Fatal, 'Error allocating DistStr array.', ErrStat, ErrMsg, RoutineName) + return + END IF + + ! Warn if we will run into issues with more than 999 nodes. + IF (p%node_total > 999 ) CALL SetErrStat(ErrID_Severe,'More than 999 blade nodes in use. Output channel headers will not '// & + 'correctly reflect blade stations beyond 999. Modifications to the variable ChanLen in FAST are required.',ErrStat,ErrMsg,RoutineName) + + DO IdxNode=1,size(p%BldNd_BlOutNd) + ! Create the name prefix: + WRITE (TmpChar,'(I3.3)') IdxNode + DistStr(IdxNode) = 'N' // TmpChar + END DO + + + ! Populate the header an unit lines for all blades and nodes + ! First set a counter so we know where in the output array we are in + INDX = p%NumOuts + 1 ! p%NumOuts is the number of outputs from the normal BeamDyn output. The WriteOutput array is sized to p%NumOuts + num(BldNdOuts) + + +! ChanPrefix = '_' !newer names have underscore character to deliniate between sections + ChanPrefix = '' + ! Loop through all the outputs we requested here: + DO IdxChan=1,p%BldNd_NumOuts + + DO IdxNode=1,size(p%BldNd_BlOutNd) + + ! Now write to the header + InitOut%WriteOutputHdr(INDX) = TRIM(ChanPrefix) // TRIM(DistStr(IdxNode)) // p%BldNd_OutParam(IdxChan)%Name + InitOut%WriteOutputUnt(INDX) = p%BldNd_OutParam(IdxChan)%Units + + ! Increment the index to the Header arrays + INDX = INDX + 1 + + ENDDO + + ENDDO + + IF (ALLOCATED(DistStr)) DEALLOCATE(DistStr) + + +END SUBROUTINE BldNdOuts_InitOut + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This subroutine populates the headers with the blade node outputs. The iteration cycle is blade:node:channel (channel iterated +!! fastest). If this iteration order is changed, it should be changed in the Calc_WriteBldNdOutput routine as well. +SUBROUTINE Calc_WriteBldNdOutput( p, m, y, ErrStat, ErrMsg ) + TYPE(BD_ParameterType), INTENT(IN ) :: p ! The module parameters + TYPE(BD_MiscVarType), INTENT(INOUT) :: m ! misc variables + TYPE(BD_OutputType), INTENT(INOUT) :: y ! outputs + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! The error status code + CHARACTER(*), INTENT( OUT) :: ErrMsg ! The error message, if an error occurred + + ! local variables + INTEGER(IntKi) :: IdxOutList ! Index within WriteOutput + INTEGER(IntKi) :: IdxChan ! Counter to the channel we are outputting. + CHARACTER(*), PARAMETER :: RoutineName = 'Calc_WriteBldNdOutput' + + + ! temporary variables for calculation + INTEGER(IntKi) :: idx_node_in_elem ! node on current element + INTEGER(IntKi) :: nelem ! current element + INTEGER(IntKi) :: idx_node ! Counter to the blade node we are on + INTEGER(IntKi) :: compIndx ! index for array component (x,y,z) + REAL(BDKi) :: Tmp33a(3,3) ! Temporary 3x4 for orientation calcs + REAL(BDKi) :: Tmp33b(3,3) ! Temporary 3x4 for orientation calcs + + REAL(BDKi) :: WM_ParamRD(3) ! Wiener Milenkovic parameters for current node, in Global coordinates + REAL(BDKi) :: temp_vec(3) ! temporary vector for orientation info. + REAL(BDKi) :: temp_vec2(3) ! temporary vector for orientation info. + REAL(BDKi) :: temp_vec3(3) ! temporary vector for orientation info. + REAL(BDKi) :: d_ref(3) ! root displacement + REAL(BDKi) :: d(3) ! displacement + + ! WM param finding + REAL(BDKi) :: RootRelOrient(3,3) + + ! Error handling + INTEGER(IntKi) :: ErrStat2 ! Temporary Error status + CHARACTER(ErrMsgLen) :: ErrMsg2 ! Temporary Error message + + + ! Initialize some things + ErrMsg = '' + ErrStat = ErrID_None + + IF ( p%BldNd_NumOuts == 0 ) THEN + return + ENDIF + + + ! Set the root rotation DCM relative to the reference. + ! NOTE: the orientations used in this routine are DCM's. These are directly from the mesh. + call LAPACK_DGEMM('T', 'N', 1.0_BDKi, m%u2%RootMotion%Orientation(:,:,1), m%u2%RootMotion%RefOrientation(:,:,1), 0.0_BDKi, RootRelOrient, ErrStat2, ErrMsg2 ) + + + ! Loop over the channel sets + DO IdxChan=1,p%BldNd_NumOuts + + + ! Case to assign output to this channel and populate based on Indx value (this indicates what the channel is) + ! Logic and mathematics used here come from Calc_WriteOutput + + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + + CASE (0) ! This is an invalid channel so we'll just skip it + CYCLE + + !---------------------------------------- + ! Sectional translational locations and deflections (relative to the undeflected position) expressed in g + CASE (BldNd_AbsXg,BldNd_AbsYg,BldNd_AbsZg) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) + CASE (BldNd_AbsXg) + compIndx = 1 + CASE (BldNd_AbsYg) + compIndx = 2 + CASE (BldNd_AbsZg) + compIndx = 3 + END SELECT + + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + d = y%BldMotion%TranslationDisp(:, idx_node) + d_ref = y%BldMotion%Position( :, idx_node) + ! For actual global location + temp_vec = d + d_ref + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + !---------------------------------------- + ! Sectional translational locations and deflections (relative to the undeflected position) expressed in r + CASE (BldNd_TDxr,BldNd_TDyr,BldNd_TDzr,BldNd_AbsXr,BldNd_AbsYr,BldNd_AbsZr) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + d = y%BldMotion%TranslationDisp(:, idx_node) - m%u2%RootMotion%TranslationDisp(:,1) + d_ref = y%BldMotion%Position( :, idx_node) - m%u2%RootMotion%Position( :,1) + ! For relative change in location + temp_vec2 = d + d_ref - matmul( RootRelOrient, d_ref ) + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1),temp_vec2) + ! For actual location relative to root + temp_vec2 = d + d_ref + temp_vec3 = MATMUL(m%u2%RootMotion%Orientation(:,:,1),temp_vec2) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + CASE (BldNd_TDxr) + y%WriteOutput( IdxOutList ) = temp_vec(1) + CASE (BldNd_TDyr) + y%WriteOutput( IdxOutList ) = temp_vec(2) + CASE (BldNd_TDzr) + y%WriteOutput( IdxOutList ) = temp_vec(3) + CASE (BldNd_AbsXr) + y%WriteOutput( IdxOutList ) = temp_vec3(1) + CASE (BldNd_AbsYr) + y%WriteOutput( IdxOutList ) = temp_vec3(2) + CASE (BldNd_AbsZr) + y%WriteOutput( IdxOutList ) = temp_vec3(3) + END SELECT + ENDDO + + + + !---------------------------------------- + ! Rotational displacements as W-M parameters + CASE ( BldNd_RDxr, BldNd_RDyr, BldNd_RDzr ) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) + CASE (BldNd_RDxr) + compIndx = 1 + CASE (BldNd_RDyr) + compIndx = 2 + CASE (BldNd_RDzr) + compIndx = 3 + END SELECT + + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + + !------------------------- +!FIXME: we are not trapping errors here. Do we need to? + ! Sectional angular/rotational deflection Wiener-Milenkovic parameter (relative to the undeflected orientation) expressed in r + call LAPACK_DGEMM('N', 'T', 1.0_BDKi, y%BldMotion%RefOrientation(:,:,idx_node), RootRelOrient, 0.0_BDKi, Tmp33b, ErrStat2, ErrMsg2 ) + call LAPACK_DGEMM('T', 'N', 1.0_BDKi, y%BldMotion%Orientation( :,:,idx_node), Tmp33b, 0.0_BDKi, Tmp33a, ErrStat2, ErrMsg2 ) + call BD_CrvExtractCrv(Tmp33a,temp_vec2, ErrStat2, ErrMsg2) ! temp_vec2 = the Wiener-Milenkovic parameters of the node's angular/rotational defelctions + WM_ParamRD = MATMUL(m%u2%RootMotion%Orientation(:,:,1),temp_vec2) ! Rotate the parameters to the correct coordinate system for output + + y%WriteOutput( IdxOutList ) = WM_ParamRD(compIndx) + END DO + + + !---------------------------------------- + ! Translational Velocities, global frame + CASE (BldNd_TVxg) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + y%WriteOutput( IdxOutList ) = y%BldMotion%TranslationVel(1,idx_node) + ENDDO + CASE (BldNd_TVyg) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + y%WriteOutput( IdxOutList ) = y%BldMotion%TranslationVel(2,idx_node) + ENDDO + CASE (BldNd_TVzg) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + y%WriteOutput( IdxOutList ) = y%BldMotion%TranslationVel(3,idx_node) + ENDDO + !---------------------------------------- + ! Rotational Velocities, global frame + CASE (BldNd_RVxg) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + y%WriteOutput( IdxOutList ) = y%BldMotion%RotationVel(1,idx_node) * R2D + ENDDO + CASE (BldNd_RVyg) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + y%WriteOutput( IdxOutList ) = y%BldMotion%RotationVel(2,idx_node) * R2D + ENDDO + CASE (BldNd_RVzg) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + y%WriteOutput( IdxOutList ) = y%BldMotion%RotationVel(3,idx_node) * R2D + ENDDO + + + !---------------------------------------- + ! Translational Velocities, local frame + CASE (BldNd_TVxl,BldNd_TVyl,BldNd_TVzl) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) + CASE (BldNd_TVxl) + compIndx = 1 + CASE (BldNd_TVyl) + compIndx = 2 + CASE (BldNd_TVzl) + compIndx = 3 + END SELECT + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node),y%BldMotion%TranslationVel(:,idx_node)) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + !---------------------------------------- + ! Rotational Velocities, local frame + CASE (BldNd_RVxl,BldNd_RVyl,BldNd_RVzl) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) + CASE (BldNd_RVxl) + compIndx = 1 + CASE (BldNd_RVyl) + compIndx = 2 + CASE (BldNd_RVzl) + compIndx = 3 + END SELECT + + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node),y%BldMotion%RotationVel(:,idx_node)) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx)*R2D + ENDDO + + + !---------------------------------------- + ! Translational Velocities, root frame + CASE (BldNd_TVxr,BldNd_TVyr,BldNd_TVzr) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) + CASE (BldNd_TVxr) + compIndx = 1 + CASE (BldNd_TVyr) + compIndx = 2 + CASE (BldNd_TVzr) + compIndx = 3 + END SELECT + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1),y%BldMotion%TranslationVel(:,idx_node)) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + !---------------------------------------- + ! Rotational Velocities, root frame + CASE (BldNd_RVxr,BldNd_RVyr,BldNd_RVzr) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) + CASE (BldNd_RVxr) + compIndx = 1 + CASE (BldNd_RVyr) + compIndx = 2 + CASE (BldNd_RVzr) + compIndx = 3 + END SELECT + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1),y%BldMotion%RotationVel(:,idx_node)) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx)*R2D + ENDDO + + + !---------------------------------------- + ! Translational Accelerations, local frame + CASE (BldNd_TAxl, BldNd_TAyl, BldNd_TAzl) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) + CASE (BldNd_TAxl) + compIndx = 1 + CASE (BldNd_TAyl) + compIndx = 2 + CASE (BldNd_TAzl) + compIndx = 3 + END SELECT + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node),y%BldMotion%TranslationAcc(:,idx_node)) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + !---------------------------------------- + ! Rotational Accelerations, local frame + CASE (BldNd_RAxl, BldNd_RAyl, BldNd_RAzl) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) + CASE (BldNd_RAxl) + compIndx = 1 + CASE (BldNd_RAyl) + compIndx = 2 + CASE (BldNd_RAzl) + compIndx = 3 + END SELECT + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node),y%BldMotion%RotationAcc(:,idx_node)) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx)*R2D + ENDDO + + + !---------------------------------------- + ! Translational Accelerations, root frame + CASE (BldNd_TAxr, BldNd_TAyr, BldNd_TAzr) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) + CASE (BldNd_TAxr) + compIndx = 1 + CASE (BldNd_TAyr) + compIndx = 2 + CASE (BldNd_TAzr) + compIndx = 3 + END SELECT + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1),y%BldMotion%TranslationAcc(:,idx_node)) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + !---------------------------------------- + ! Rotational Accelerations, root frame + CASE (BldNd_RAxr, BldNd_RAyr, BldNd_RAzr) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) + CASE (BldNd_RAxr) + compIndx = 1 + CASE (BldNd_RAyr) + compIndx = 2 + CASE (BldNd_RAzr) + compIndx = 3 + END SELECT + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1),y%BldMotion%RotationAcc(:,idx_node)) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx)*R2D + ENDDO + + !---------------------------------------- + ! Applied point forces, local coordinate system. Not used when coupled to FAST. + CASE (BldNd_PFxl,BldNd_PFyl,BldNd_PFzl) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) + CASE (BldNd_PFxl) + compIndx = 1 + CASE (BldNd_PFyl) + compIndx = 2 + CASE (BldNd_PFzl) + compIndx = 3 + END SELECT + if (p%BldMotionNodeLoc == BD_MESH_FE) THEN + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), m%u2%PointLoad%Force( :,p%NdIndxInverse(idx_node))) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + else ! we need to do a mesh mapping first +!FIXME: this is not implemented yet. + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes + y%WriteOutput( IdxOutList ) = 0.0_ReKi + ENDDO + end if + + !---------------------------------------- + ! Applied point moments, local coordinate system. Not used when coupled to FAST. + CASE (BldNd_PMxl, BldNd_PMyl, BldNd_PMzl) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) + CASE (BldNd_PMxl) + compIndx = 1 + CASE (BldNd_PMyl) + compIndx = 2 + CASE (BldNd_PMzl) + compIndx = 3 + END SELECT + DO idx_node=1,y%BldMotion%NNodes + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes + y%WriteOutput( IdxOutList ) = 0.0_ReKi + ENDDO + if (p%BldMotionNodeLoc == BD_MESH_FE) THEN + DO idx_node=1,y%BldMotion%NNodes + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), m%u2%PointLoad%Moment( :,p%NdIndxInverse(idx_node))) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + else ! we need to do a mesh mapping first +!FIXME: this is not implemented yet. + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes + y%WriteOutput( IdxOutList ) = 0.0_ReKi + ENDDO + end if + + !---------------------------------------- + ! Applied distributed forces (from AD15 when coupled to FAST), local frame + CASE (BldNd_DFxl,BldNd_DFyl,BldNd_DFzl) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) + CASE (BldNd_DFxl) + compIndx = 1 + CASE (BldNd_DFyl) + compIndx = 2 + CASE (BldNd_DFzl) + compIndx = 3 + END SELECT + if (p%BldMotionNodeLoc == BD_MESH_QP) THEN ! If we are on the quadrature points, the input and output meshes are siblings + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), m%u2%DistrLoad%Force( :,idx_node)) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + else + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), m%u_DistrLoad_at_y%Force( :,idx_node)) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + end if + !---------------------------------------- + ! Applied distributed moments (from AD15 when coupled to FAST), local frame + CASE (BldNd_DMxl,BldNd_DMyl,BldNd_DMzl) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) + CASE (BldNd_DMxl) + compIndx = 1 + CASE (BldNd_DMyl) + compIndx = 2 + CASE (BldNd_DMzl) + compIndx = 3 + END SELECT + if (p%BldMotionNodeLoc == BD_MESH_QP) THEN ! If we are on the quadrature points, the input and output meshes are siblings + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), m%u2%DistrLoad%Moment( :,idx_node)) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + else + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), m%u_DistrLoad_at_y%Moment( :,idx_node)) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + end if + + !---------------------------------------- + ! Applied distributed forces (from AD15 when coupled to FAST), root frame + CASE (BldNd_DFxr,BldNd_DFyr,BldNd_DFzr) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) + CASE (BldNd_DFxr) + compIndx = 1 + CASE (BldNd_DFyr) + compIndx = 2 + CASE (BldNd_DFzr) + compIndx = 3 + END SELECT + if (p%BldMotionNodeLoc == BD_MESH_QP) THEN ! If we are on the quadrature points, the input and output meshes are siblings + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), m%u2%DistrLoad%Force( :,idx_node)) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + else + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), m%u_DistrLoad_at_y%Force( :,idx_node)) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + end if + !---------------------------------------- + ! Applied distributed moments (from AD15 when coupled to FAST), root frame + CASE (BldNd_DMxr,BldNd_DMyr,BldNd_DMzr) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) + CASE (BldNd_DMxr) + compIndx = 1 + CASE (BldNd_DMyr) + compIndx = 2 + CASE (BldNd_DMzr) + compIndx = 3 + END SELECT + if (p%BldMotionNodeLoc == BD_MESH_QP) THEN ! If we are on the quadrature points, the input and output meshes are siblings + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), m%u2%DistrLoad%Moment( :,idx_node)) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + else + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), m%u_DistrLoad_at_y%Moment( :,idx_node)) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + end if + + + !---------------------------------------- + ! Internal Forces, local + CASE (BldNd_Fxl,BldNd_Fyl,BldNd_Fzl) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) + CASE (BldNd_Fxl) + compIndx = 1 + CASE (BldNd_Fyl) + compIndx = 2 + CASE (BldNd_Fzl) + compIndx = 3 + END SELECT + + if (p%BldMotionNodeLoc == BD_MESH_QP) then + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), m%BldInternalForceQP(1:3,p%NdIndxInverse(idx_node))) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + else + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), m%BldInternalForceFE(1:3,p%NdIndxInverse(idx_node))) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + end if + + !---------------------------------------- + ! Internal Moments, local + CASE (BldNd_Mxl,BldNd_Myl,BldNd_Mzl) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) + CASE (BldNd_Mxl) + compIndx = 1 + CASE (BldNd_Myl) + compIndx = 2 + CASE (BldNd_Mzl) + compIndx = 3 + END SELECT + if (p%BldMotionNodeLoc == BD_MESH_QP) then + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), m%BldInternalForceQP(4:6,p%NdIndxInverse(idx_node))) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + else + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), m%BldInternalForceFE(4:6,p%NdIndxInverse(idx_node))) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + end if + + !---------------------------------------- + ! Internal Forces, root frame + CASE (BldNd_Fxr,BldNd_Fyr,BldNd_Fzr) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) + CASE (BldNd_Fxr) + compIndx = 1 + CASE (BldNd_Fyr) + compIndx = 2 + CASE (BldNd_Fzr) + compIndx = 3 + END SELECT + if (p%BldMotionNodeLoc == BD_MESH_QP) then + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), m%BldInternalForceQP(1:3,p%NdIndxInverse(idx_node))) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + else + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), m%BldInternalForceFE(1:3,p%NdIndxInverse(idx_node))) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + end if + + !---------------------------------------- + ! Internal Moments, root frame + CASE (BldNd_Mxr,BldNd_Myr,BldNd_Mzr) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) + CASE (BldNd_Mxr) + compIndx = 1 + CASE (BldNd_Myr) + compIndx = 2 + CASE (BldNd_Mzr) + compIndx = 3 + END SELECT + + if (p%BldMotionNodeLoc == BD_MESH_QP) then + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), m%BldInternalForceQP(4:6,p%NdIndxInverse(idx_node))) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + else + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), m%BldInternalForceFE(4:6,p%NdIndxInverse(idx_node))) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + end if + +!>>> The remaining loads outputs are for debugging, and are not valid with BD_MESH_FE. We cannot get here in that case. + !---------------------------------------- + ! Internal forces from CalcOutput, local frame + CASE (BldNd_FFbxl,BldNd_FFbyl,BldNd_FFbzl) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) + CASE (BldNd_FFbxl) + compIndx = 1 + CASE (BldNd_FFbyl) + compIndx = 2 + CASE (BldNd_FFbzl) + compIndx = 3 + END SELECT + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + nelem = p%OutNd2NdElem(2,idx_node) + idx_node_in_elem = p%OutNd2NdElem(1,idx_node) + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), MATMUL(p%GlbRot,m%qp%Fb(1:3,idx_node_in_elem,nelem))) + y%WriteOutput( IdxOutList ) = temp_vec(compIndx) + ENDDO + CASE (BldNd_MFbxl,BldNd_MFbyl,BldNd_MFbzl) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + nelem = p%OutNd2NdElem(2,idx_node) + idx_node_in_elem = p%OutNd2NdElem(1,idx_node) + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), MATMUL(p%GlbRot,m%qp%Fb(4:6,idx_node_in_elem,nelem))) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + CASE (BldNd_MFbxl) ! Gyroscopic moment Fc about x, root frame + y%WriteOutput( IdxOutList ) = temp_vec(1) + CASE (BldNd_MFbyl) ! Gyroscopic moment Fc about y, root frame + y%WriteOutput( IdxOutList ) = temp_vec(2) + CASE (BldNd_MFbzl) ! Gyroscopic moment Fc about z, root frame + y%WriteOutput( IdxOutList ) = temp_vec(3) + END SELECT + ENDDO + + CASE (BldNd_FFcxl,BldNd_FFcyl,BldNd_FFczl) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + nelem = p%OutNd2NdElem(2,idx_node) + idx_node_in_elem = p%OutNd2NdElem(1,idx_node) + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), MATMUL(p%GlbRot,m%qp%Fc(1:3,idx_node_in_elem,nelem))) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + CASE (BldNd_FFcxl) ! Gyroscopic force Fc x, root frame + y%WriteOutput( IdxOutList ) = temp_vec(1) + CASE (BldNd_FFcyl) ! Gyroscopic force Fc y, root frame + y%WriteOutput( IdxOutList ) = temp_vec(2) + CASE (BldNd_FFczl) ! Gyroscopic force Fc z, root frame + y%WriteOutput( IdxOutList ) = temp_vec(3) + END SELECT + ENDDO + CASE (BldNd_MFcxl,BldNd_MFcyl,BldNd_MFczl) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + nelem = p%OutNd2NdElem(2,idx_node) + idx_node_in_elem = p%OutNd2NdElem(1,idx_node) + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), MATMUL(p%GlbRot,m%qp%Fc(4:6,idx_node_in_elem,nelem))) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + CASE (BldNd_MFcxl) ! Gyroscopic moment Fc about x, root frame + y%WriteOutput( IdxOutList ) = temp_vec(1) + CASE (BldNd_MFcyl) ! Gyroscopic moment Fc about y, root frame + y%WriteOutput( IdxOutList ) = temp_vec(2) + CASE (BldNd_MFczl) ! Gyroscopic moment Fc about z, root frame + y%WriteOutput( IdxOutList ) = temp_vec(3) + END SELECT + ENDDO + + CASE (BldNd_FFdxl,BldNd_FFdyl,BldNd_FFdzl) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + nelem = p%OutNd2NdElem(2,idx_node) + idx_node_in_elem = p%OutNd2NdElem(1,idx_node) + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), MATMUL(p%GlbRot,m%qp%Fd(1:3,idx_node_in_elem,nelem))) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + CASE (BldNd_FFdxl) ! Gyroscopic force Fc x, root frame + y%WriteOutput( IdxOutList ) = temp_vec(1) + CASE (BldNd_FFdyl) ! Gyroscopic force Fc y, root frame + y%WriteOutput( IdxOutList ) = temp_vec(2) + CASE (BldNd_FFdzl) ! Gyroscopic force Fc z, root frame + y%WriteOutput( IdxOutList ) = temp_vec(3) + END SELECT + ENDDO + CASE (BldNd_MFdxl,BldNd_MFdyl,BldNd_MFdzl) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + nelem = p%OutNd2NdElem(2,idx_node) + idx_node_in_elem = p%OutNd2NdElem(1,idx_node) + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), MATMUL(p%GlbRot,m%qp%Fd(4:6,idx_node_in_elem,nelem))) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + CASE (BldNd_MFdxl) ! Gyroscopic moment Fc about x, root frame + y%WriteOutput( IdxOutList ) = temp_vec(1) + CASE (BldNd_MFdyl) ! Gyroscopic moment Fc about y, root frame + y%WriteOutput( IdxOutList ) = temp_vec(2) + CASE (BldNd_MFdzl) ! Gyroscopic moment Fc about z, root frame + y%WriteOutput( IdxOutList ) = temp_vec(3) + END SELECT + ENDDO + + CASE (BldNd_FFgxl,BldNd_FFgyl,BldNd_FFgzl) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + nelem = p%OutNd2NdElem(2,idx_node) + idx_node_in_elem = p%OutNd2NdElem(1,idx_node) + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), MATMUL(p%GlbRot,m%qp%Fg(1:3,idx_node_in_elem,nelem))) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + CASE (BldNd_FFgxl) ! Gyroscopic force Fc x, root frame + y%WriteOutput( IdxOutList ) = temp_vec(1) + CASE (BldNd_FFgyl) ! Gyroscopic force Fc y, root frame + y%WriteOutput( IdxOutList ) = temp_vec(2) + CASE (BldNd_FFgzl) ! Gyroscopic force Fc z, root frame + y%WriteOutput( IdxOutList ) = temp_vec(3) + END SELECT + ENDDO + CASE (BldNd_MFgxl,BldNd_MFgyl,BldNd_MFgzl) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + nelem = p%OutNd2NdElem(2,idx_node) + idx_node_in_elem = p%OutNd2NdElem(1,idx_node) + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), MATMUL(p%GlbRot,m%qp%Fg(4:6,idx_node_in_elem,nelem))) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + CASE (BldNd_MFgxl) ! Gyroscopic moment Fc about x, root frame + y%WriteOutput( IdxOutList ) = temp_vec(1) + CASE (BldNd_MFgyl) ! Gyroscopic moment Fc about y, root frame + y%WriteOutput( IdxOutList ) = temp_vec(2) + CASE (BldNd_MFgzl) ! Gyroscopic moment Fc about z, root frame + y%WriteOutput( IdxOutList ) = temp_vec(3) + END SELECT + ENDDO + + + + !---------------------------------------- + ! Internal forces from CalcOutput, local frame + CASE (BldNd_FFbxr,BldNd_FFbyr,BldNd_FFbzr) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + nelem = p%OutNd2NdElem(2,idx_node) + idx_node_in_elem = p%OutNd2NdElem(1,idx_node) + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), MATMUL(p%GlbRot,m%qp%Fb(1:3,idx_node_in_elem,nelem))) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + CASE (BldNd_FFbxr) ! Gyroscopic force Fc x, root frame + y%WriteOutput( IdxOutList ) = temp_vec(1) + CASE (BldNd_FFbyr) ! Gyroscopic force Fc y, root frame + y%WriteOutput( IdxOutList ) = temp_vec(2) + CASE (BldNd_FFbzr) ! Gyroscopic force Fc z, root frame + y%WriteOutput( IdxOutList ) = temp_vec(3) + END SELECT + ENDDO + CASE (BldNd_MFbxr,BldNd_MFbyr,BldNd_MFbzr) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + nelem = p%OutNd2NdElem(2,idx_node) + idx_node_in_elem = p%OutNd2NdElem(1,idx_node) + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), MATMUL(p%GlbRot,m%qp%Fb(4:6,idx_node_in_elem,nelem))) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + CASE (BldNd_MFbxr) ! Gyroscopic moment Fc about x, root frame + y%WriteOutput( IdxOutList ) = temp_vec(1) + CASE (BldNd_MFbyr) ! Gyroscopic moment Fc about y, root frame + y%WriteOutput( IdxOutList ) = temp_vec(2) + CASE (BldNd_MFbzr) ! Gyroscopic moment Fc about z, root frame + y%WriteOutput( IdxOutList ) = temp_vec(3) + END SELECT + ENDDO + + CASE (BldNd_FFcxr,BldNd_FFcyr,BldNd_FFczr) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + nelem = p%OutNd2NdElem(2,idx_node) + idx_node_in_elem = p%OutNd2NdElem(1,idx_node) + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), MATMUL(p%GlbRot,m%qp%Fc(1:3,idx_node_in_elem,nelem))) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + CASE (BldNd_FFcxr) ! Gyroscopic force Fc x, root frame + y%WriteOutput( IdxOutList ) = temp_vec(1) + CASE (BldNd_FFcyr) ! Gyroscopic force Fc y, root frame + y%WriteOutput( IdxOutList ) = temp_vec(2) + CASE (BldNd_FFczr) ! Gyroscopic force Fc z, root frame + y%WriteOutput( IdxOutList ) = temp_vec(3) + END SELECT + ENDDO + CASE (BldNd_MFcxr,BldNd_MFcyr,BldNd_MFczr) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + nelem = p%OutNd2NdElem(2,idx_node) + idx_node_in_elem = p%OutNd2NdElem(1,idx_node) + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), MATMUL(p%GlbRot,m%qp%Fc(4:6,idx_node_in_elem,nelem))) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + CASE (BldNd_MFcxr) ! Gyroscopic moment Fc about x, root frame + y%WriteOutput( IdxOutList ) = temp_vec(1) + CASE (BldNd_MFcyr) ! Gyroscopic moment Fc about y, root frame + y%WriteOutput( IdxOutList ) = temp_vec(2) + CASE (BldNd_MFczr) ! Gyroscopic moment Fc about z, root frame + y%WriteOutput( IdxOutList ) = temp_vec(3) + END SELECT + ENDDO + + CASE (BldNd_FFdxr,BldNd_FFdyr,BldNd_FFdzr) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + nelem = p%OutNd2NdElem(2,idx_node) + idx_node_in_elem = p%OutNd2NdElem(1,idx_node) + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), MATMUL(p%GlbRot,m%qp%Fd(1:3,idx_node_in_elem,nelem))) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + CASE (BldNd_FFdxr) ! Gyroscopic force Fc x, root frame + y%WriteOutput( IdxOutList ) = temp_vec(1) + CASE (BldNd_FFdyr) ! Gyroscopic force Fc y, root frame + y%WriteOutput( IdxOutList ) = temp_vec(2) + CASE (BldNd_FFdzr) ! Gyroscopic force Fc z, root frame + y%WriteOutput( IdxOutList ) = temp_vec(3) + END SELECT + ENDDO + CASE (BldNd_MFdxr,BldNd_MFdyr,BldNd_MFdzr) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + nelem = p%OutNd2NdElem(2,idx_node) + idx_node_in_elem = p%OutNd2NdElem(1,idx_node) + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), MATMUL(p%GlbRot,m%qp%Fd(4:6,idx_node_in_elem,nelem))) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + CASE (BldNd_MFdxr) ! Gyroscopic moment Fc about x, root frame + y%WriteOutput( IdxOutList ) = temp_vec(1) + CASE (BldNd_MFdyr) ! Gyroscopic moment Fc about y, root frame + y%WriteOutput( IdxOutList ) = temp_vec(2) + CASE (BldNd_MFdzr) ! Gyroscopic moment Fc about z, root frame + y%WriteOutput( IdxOutList ) = temp_vec(3) + END SELECT + ENDDO + + CASE (BldNd_FFgxr,BldNd_FFgyr,BldNd_FFgzr) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + nelem = p%OutNd2NdElem(2,idx_node) + idx_node_in_elem = p%OutNd2NdElem(1,idx_node) + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), MATMUL(p%GlbRot,m%qp%Fg(1:3,idx_node_in_elem,nelem))) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + CASE (BldNd_FFgxr) ! Gyroscopic force Fc x, root frame + y%WriteOutput( IdxOutList ) = temp_vec(1) + CASE (BldNd_FFgyr) ! Gyroscopic force Fc y, root frame + y%WriteOutput( IdxOutList ) = temp_vec(2) + CASE (BldNd_FFgzr) ! Gyroscopic force Fc z, root frame + y%WriteOutput( IdxOutList ) = temp_vec(3) + END SELECT + ENDDO + CASE (BldNd_MFgxr,BldNd_MFgyr,BldNd_MFgzr) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + nelem = p%OutNd2NdElem(2,idx_node) + idx_node_in_elem = p%OutNd2NdElem(1,idx_node) + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), m%qp%Fg(4:6,idx_node_in_elem,nelem)) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + CASE (BldNd_MFgxr) ! Gyroscopic moment Fc about x, root frame + y%WriteOutput( IdxOutList ) = temp_vec(1) + CASE (BldNd_MFgyr) ! Gyroscopic moment Fc about y, root frame + y%WriteOutput( IdxOutList ) = temp_vec(2) + CASE (BldNd_MFgzr) ! Gyroscopic moment Fc about z, root frame + y%WriteOutput( IdxOutList ) = temp_vec(3) + END SELECT + ENDDO + + + !---------------------------------------- + ! Inertial force from UpdateStates (Includes a few other terms), local frame + CASE (BldNd_FFixl,BldNd_FFiyl,BldNd_FFizl) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + nelem = p%OutNd2NdElem(2,idx_node) + idx_node_in_elem = p%OutNd2NdElem(1,idx_node) + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), MATMUL(p%GlbRot,m%qp%Fi(1:3,idx_node_in_elem,nelem))) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + CASE (BldNd_FFixl) ! Gyroscopic force Fc x, root frame + y%WriteOutput( IdxOutList ) = temp_vec(1) + CASE (BldNd_FFiyl) ! Gyroscopic force Fc y, root frame + y%WriteOutput( IdxOutList ) = temp_vec(2) + CASE (BldNd_FFizl) ! Gyroscopic force Fc z, root frame + y%WriteOutput( IdxOutList ) = temp_vec(3) + END SELECT + ENDDO + CASE (BldNd_MFixl,BldNd_MFiyl,BldNd_MFizl) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + nelem = p%OutNd2NdElem(2,idx_node) + idx_node_in_elem = p%OutNd2NdElem(1,idx_node) + temp_vec = MATMUL(y%BldMotion%Orientation(:,:,idx_node), MATMUL(p%GlbRot,m%qp%Fi(4:6,idx_node_in_elem,nelem))) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + CASE (BldNd_MFixl) ! Gyroscopic moment Fc about x, root frame + y%WriteOutput( IdxOutList ) = temp_vec(1) + CASE (BldNd_MFiyl) ! Gyroscopic moment Fc about y, root frame + y%WriteOutput( IdxOutList ) = temp_vec(2) + CASE (BldNd_MFizl) ! Gyroscopic moment Fc about z, root frame + y%WriteOutput( IdxOutList ) = temp_vec(3) + END SELECT + ENDDO + + !---------------------------------------- + ! Inertial force from UpdateStates (Includes a few other terms), root frame + CASE (BldNd_FFixr,BldNd_FFiyr,BldNd_FFizr) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + nelem = p%OutNd2NdElem(2,idx_node) + idx_node_in_elem = p%OutNd2NdElem(1,idx_node) + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), MATMUL(p%GlbRot,m%qp%Fi(1:3,idx_node_in_elem,nelem))) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + CASE (BldNd_FFixr) ! Gyroscopic force Fc x, root frame + y%WriteOutput( IdxOutList ) = temp_vec(1) + CASE (BldNd_FFiyr) ! Gyroscopic force Fc y, root frame + y%WriteOutput( IdxOutList ) = temp_vec(2) + CASE (BldNd_FFizr) ! Gyroscopic force Fc z, root frame + y%WriteOutput( IdxOutList ) = temp_vec(3) + END SELECT + ENDDO + CASE (BldNd_MFixr,BldNd_MFiyr,BldNd_MFizr) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes ! Index to current output + nelem = p%OutNd2NdElem(2,idx_node) + idx_node_in_elem = p%OutNd2NdElem(1,idx_node) + temp_vec = MATMUL(m%u2%RootMotion%Orientation(:,:,1), MATMUL(p%GlbRot,m%qp%Fi(4:6,idx_node_in_elem,nelem))) + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + CASE (BldNd_MFixr) ! Gyroscopic moment Fc about x, root frame + y%WriteOutput( IdxOutList ) = temp_vec(1) + CASE (BldNd_MFiyr) ! Gyroscopic moment Fc about y, root frame + y%WriteOutput( IdxOutList ) = temp_vec(2) + CASE (BldNd_MFizr) ! Gyroscopic moment Fc about z, root frame + y%WriteOutput( IdxOutList ) = temp_vec(3) + END SELECT + ENDDO + + + + CASE DEFAULT + CALL SetErrStat( ErrID_Severe, "Coding error. Output channel not properly set.",ErrStat,ErrMsg,RoutineName ) + DO idx_node=1,y%BldMotion%NNodes ! Note p%node_total is total number of nodes including all elements + IdxOutList = p%NumOuts + idx_node + (IdxChan-1)*y%BldMotion%NNodes + y%WriteOutput( IdxOutList ) = 0.0_ReKi + ENDDO + + END SELECT + + ENDDO ! Loop over the output channel list + + +END SUBROUTINE Calc_WriteBldNdOutput + +!.................................................................................................................................. +SUBROUTINE BldNdOuts_SetParameters(InitInp, InputFileData, p, ErrStat, ErrMsg) + type(BD_InitInputType), intent(in ) :: InitInp !< Input data for initialization routine + type(BD_InputFile), intent(in ) :: InputFileData !< data from the input file + type(BD_ParameterType), intent(inout) :: p !< Parameters ! intent(out) only because it changes p%NdIndx + integer(IntKi), intent( out) :: ErrStat !< Error status of the operation + character(*), intent( out) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + integer(IntKi) :: i + integer(IntKi) :: ErrStat2 + character(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = ('BldNdOuts_SetParameters') + + + ! Initialize values + ErrStat = ErrID_None + ErrMsg = "" + + + ! Set the parameter to store number of requested Blade Node output sets + p%BldNd_NumOuts = InputFileData%BldNd_NumOuts + + IF ( p%BldNd_NumOuts == 0 ) THEN + + p%BldNd_TotNumOuts = 0 ! default to no nodal outputs + + ELSE + + ! Check if the blade node array to output is valid: p%BldNd_BlOutNd + ! TODO: this value is not read in by the input file reading yet, so setting to all blade nodes + ! -- check if list handed in is of nodes that exist (not sure this is ever checked) + ! -- Make sure the nodes actually exist on the y%BldMotion mesh + ! -- Sort the order of the list handed in + ! -- copy values over + + + ! Temporary workaround here: + ALLOCATE ( p%BldNd_BlOutNd( size(p%NdIndxInverse) ) , STAT=ErrStat2 ) + IF ( ErrStat2 /= 0_IntKi ) THEN + CALL SetErrStat( ErrID_Fatal,"Error allocating memory for the BeamDyn BldNd_BlOutNd array.", ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + DO I=1,size(p%BldNd_BlOutNd) + p%BldNd_BlOutNd(i) = i + ENDDO + + ! Set the total number of outputs ( requested channel groups * number requested nodes ) + p%BldNd_TotNumOuts = p%BldNd_NumOuts * SIZE(p%BldNd_BlOutNd) + + call BldNdOuts_SetOutParam(InputFileData%BldNd_OutList, p, ErrStat2, ErrMsg2 ) + call setErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat >= AbortErrLev) return + + END IF + + +END SUBROUTINE BldNdOuts_SetParameters +!********************************************************************************************************************************** +! NOTE: The following lines of code were generated by a Matlab script called "Write_ChckOutLst.m" +! using the parameters listed in the "OutListParameters.xlsx" Excel file. Any changes to these +! lines should be modified in the Matlab script and/or Excel worksheet as necessary. +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine checks to see if any requested output channel names (stored in the OutList(:)) are invalid. It returns a +!! warning if any of the channels are not available outputs from the module. +!! It assigns the settings for OutParam(:) (i.e, the index, name, and units of the output channels, WriteOutput(:)). +!! the sign is set to 0 if the channel is invalid. +!! It sets assumes the value p%NumOuts has been set before this routine has been called, and it sets the values of p%OutParam here. +!! +!! This routine was generated by Write_ChckOutLst.m using the parameters listed in OutListParameters.xlsx at 12-Dec-2017 20:48:14. +SUBROUTINE BldNdOuts_SetOutParam(BldNd_OutList, p, ErrStat, ErrMsg ) +!.................................................................................................................................. + + IMPLICIT NONE + + ! Passed variables + + CHARACTER(ChanLen), INTENT(IN) :: BldNd_OutList(:) !< The list out user-requested outputs + TYPE(BD_ParameterType), INTENT(INOUT) :: p !< The module parameters + INTEGER(IntKi), INTENT(OUT) :: ErrStat !< The error status code + CHARACTER(*), INTENT(OUT) :: ErrMsg !< The error message, if an error occurred + + ! Local variables + + INTEGER :: ErrStat2 ! temporary (local) error status + INTEGER :: I ! Generic loop-counting index + INTEGER :: J ! Generic loop-counting index + INTEGER :: INDX ! Index for valid arrays + + LOGICAL :: InvalidOutput(1:BldNd_MaxOutPts) ! This array determines if the output channel is valid for this configuration + CHARACTER(ChanLen) :: OutListTmp ! A string to temporarily hold OutList(I) + CHARACTER(*), PARAMETER :: RoutineName = "BldNdOuts_SetOutParam" + + CHARACTER(OutStrLenM1), PARAMETER :: ValidParamAry(177) = (/ & ! This lists the names of the allowed parameters, which must be sorted alphabetically + "ABSXG ","ABSXR ","ABSYG ","ABSYR ","ABSZG ", & + "ABSZR ","AXB ","AXL ","AYB ","AYL ","AZB ","AZL ", & + "DFXL ","DFXR ","DFYL ","DFYR ","DFZL ","DFZR ","DMXL ", & + "DMXR ","DMYL ","DMYR ","DMZL ","DMZR ","FFBXL ","FFBXR ","FFBYL ", & + "FFBYR ","FFBZL ","FFBZR ","FFCXL ","FFCXR ","FFCYL ","FFCYR ","FFCZL ", & + "FFCZR ","FFDXL ","FFDXR ","FFDYL ","FFDYR ","FFDZL ","FFDZR ","FFGXL ", & + "FFGXR ","FFGYL ","FFGYR ","FFGZL ","FFGZR ","FFIXL ","FFIXR ","FFIYL ", & + "FFIYR ","FFIZL ","FFIZR ","FXB ","FXL ","FXR ","FYB ","FYL ", & + "FYR ","FZB ","FZL ","FZR ","MFBXL ","MFBXR ","MFBYL ","MFBYR ", & + "MFBZL ","MFBZR ","MFCXL ","MFCXR ","MFCYL ","MFCYR ","MFCZL ","MFCZR ", & + "MFDXL ","MFDXR ","MFDYL ","MFDYR ","MFDZL ","MFDZR ","MFGXL ","MFGXR ", & + "MFGYL ","MFGYR ","MFGZL ","MFGZR ","MFIXL ","MFIXR ","MFIYL ","MFIYR ", & + "MFIZL ","MFIZR ","MXB ","MXL ","MXR ","MYB ","MYL ","MYR ", & + "MZB ","MZL ","MZR ","PFXL ","PFYL ","PFZL ","PMXL ","PMYL ", & + "PMZL ","PXB ","PXG ","PYB ","PYG ","PZB ","PZG ","QXB ", & + "QXL ","QYB ","QYL ","QZB ","QZL ","RAXL ","RAXR ","RAYL ", & + "RAYR ","RAZL ","RAZR ","RDXR ","RDYR ", & + "RDZR ","RVXG ","RVXL ","RVXR ","RVYG ","RVYL ","RVYR ","RVZG ", & + "RVZL ","RVZR ","TAXL ","TAXR ","TAYL ", & + "TAYR ","TAZL ","TAZR ","TDXR ","TDYR ","TDZR ", & + "TVXG ","TVXL ","TVXR ","TVYG ","TVYL ","TVYR ","TVZG ","TVZL ", & + "TVZR ","UXB ","UYB ","UZB ","VXB ","VXG ", & + "VXL ","VYB ","VYG ","VYL ","VZB ","VZG ","VZL ","WXB ", & + "WXG ","WXL ","WYB ","WYG ","WYL ","WZB ","WZG ","WZL "/) + INTEGER(IntKi), PARAMETER :: ParamIndxAry(177) = (/ & ! This lists the index into AllOuts(:) of the allowed parameters ValidParamAry(:) + BldNd_AbsXg , BldNd_AbsXr , BldNd_AbsYg , BldNd_AbsYr , BldNd_AbsZg , & + BldNd_AbsZr , BldNd_TAxr , BldNd_TAxl , BldNd_TAyr , BldNd_TAyl , BldNd_TAzr , BldNd_TAzl , & + BldNd_DFxL , BldNd_DFxR , BldNd_DFyL , BldNd_DFyR , BldNd_DFzL , BldNd_DFzR , BldNd_DMxL , & + BldNd_DMxR , BldNd_DMyL , BldNd_DMyR , BldNd_DMzL , BldNd_DMzR , BldNd_FFbxl , BldNd_FFbxr , BldNd_FFbyl , & + BldNd_FFbyr , BldNd_FFbzl , BldNd_FFbzr , BldNd_FFcxl , BldNd_FFcxr , BldNd_FFcyl , BldNd_FFcyr , BldNd_FFczl , & + BldNd_FFczr , BldNd_FFdxl , BldNd_FFdxr , BldNd_FFdyl , BldNd_FFdyr , BldNd_FFdzl , BldNd_FFdzr , BldNd_FFgxl , & + BldNd_FFgxr , BldNd_FFgyl , BldNd_FFgyr , BldNd_FFgzl , BldNd_FFgzr , BldNd_FFixl , BldNd_FFixr , BldNd_FFiyl , & + BldNd_FFiyr , BldNd_FFizl , BldNd_FFizr , BldNd_Fxr , BldNd_FxL , BldNd_Fxr , BldNd_Fyr , BldNd_FyL , & + BldNd_Fyr , BldNd_Fzr , BldNd_FzL , BldNd_Fzr , BldNd_MFbxl , BldNd_MFbxr , BldNd_MFbyl , BldNd_MFbyr , & + BldNd_MFbzl , BldNd_MFbzr , BldNd_MFcxl , BldNd_MFcxr , BldNd_MFcyl , BldNd_MFcyr , BldNd_MFczl , BldNd_MFczr , & + BldNd_MFdxl , BldNd_MFdxr , BldNd_MFdyl , BldNd_MFdyr , BldNd_MFdzl , BldNd_MFdzr , BldNd_MFgxl , BldNd_MFgxr , & + BldNd_MFgyl , BldNd_MFgyr , BldNd_MFgzl , BldNd_MFgzr , BldNd_MFixl , BldNd_MFixr , BldNd_MFiyl , BldNd_MFiyr , & + BldNd_MFizl , BldNd_MFizr , BldNd_Mxr , BldNd_MxL , BldNd_Mxr , BldNd_Myr , BldNd_MyL , BldNd_Myr , & + BldNd_Mzr , BldNd_MzL , BldNd_Mzr , BldNd_PFxL , BldNd_PFyL , BldNd_PFzL , BldNd_PMxL , BldNd_PMyL , & + BldNd_PMzL , BldNd_AbsXr , BldNd_AbsXg , BldNd_AbsYr , BldNd_AbsYg , BldNd_AbsZr , BldNd_AbsZg , BldNd_RAxr , & + BldNd_RAxl , BldNd_RAyr , BldNd_RAyl , BldNd_RAzr , BldNd_RAzl , BldNd_RAxl , BldNd_RAxr , BldNd_RAyl , & + BldNd_RAyr , BldNd_RAzl , BldNd_RAzr , BldNd_RDxr , BldNd_RDyr , & + BldNd_RDzr , BldNd_RVxg , BldNd_RVxl , BldNd_RVxr , BldNd_RVyg , BldNd_RVyl , BldNd_RVyr , BldNd_RVzg , & + BldNd_RVzl , BldNd_RVzr , BldNd_TAxl , BldNd_TAxr , BldNd_TAyl , & + BldNd_TAyr , BldNd_TAzl , BldNd_TAzr , BldNd_TDxr , BldNd_TDyr , BldNd_TDzr , & + BldNd_TVxg , BldNd_TVxl , BldNd_TVxr , BldNd_TVyg , BldNd_TVyl , BldNd_TVyr , BldNd_TVzg , BldNd_TVzl , & + BldNd_TVzr , BldNd_TDxr , BldNd_TDyr , BldNd_TDzr , BldNd_TVxr , BldNd_TVxg , & + BldNd_TVxl , BldNd_TVyr , BldNd_TVyg , BldNd_TVyl , BldNd_TVzr , BldNd_TVzg , BldNd_TVzl , BldNd_RVxr , & + BldNd_RVxg , BldNd_RVxl , BldNd_RVyr , BldNd_RVyg , BldNd_RVyl , BldNd_RVzr , BldNd_RVzg , BldNd_RVzl /) + CHARACTER(ChanLen), PARAMETER :: ParamUnitsAry(177) = (/ & ! This lists the units corresponding to the allowed parameters + "(m) ","(m) ","(m) ","(m) ","(m) ", & + "(m) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ","(m/s^2) ",& + "(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N/m) ","(N-m/m) ", & + "(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N-m/m) ","(N) ","(N) ","(N) ", & + "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & + "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & + "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & + "(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ","(N) ", & + "(N) ","(N) ","(N) ","(N) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ", & + "(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ", & + "(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ", & + "(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ", & + "(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ","(N-m) ", & + "(N-m) ","(N-m) ","(N-m) ","(N) ","(N) ","(N) ","(N-m) ","(N-m) ", & + "(N-m) ","(m) ","(m) ","(m) ","(m) ","(m) ","(m) ","(deg/s^2)", & + "(deg/s^2)","(deg/s^2)","(deg/s^2)","(deg/s^2)","(deg/s^2)","(deg/s^2)","(deg/s^2)","(deg/s^2)", & + "(deg/s^2)","(deg/s^2)","(deg/s^2)","(-) ","(-) ", & + "(-) ","(deg/s) ","(deg/s) ","(deg/s) ","(deg/s) ","(deg/s) ","(deg/s) ","(deg/s) ", & + "(deg/s) ","(deg/s) ","(m/s^2) ","(m/s^2) ","(m/s^2) ", & + "(m/s^2) ","(m/s^2) ","(m/s^2) ","(m) ","(m) ","(m) ", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ", & + "(m/s) ","(m) ","(m) ","(m) ","(m/s) ","(m/s) ", & + "(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(m/s) ","(deg/s) ", & + "(deg/s) ","(deg/s) ","(deg/s) ","(deg/s) ","(deg/s) ","(deg/s) ","(deg/s) ","(deg/s) "/) + + + ! Initialize values + ErrStat = ErrID_None + ErrMsg = "" + InvalidOutput = .FALSE. + + +! ..... Developer must add checking for invalid inputs here: ..... + + ! these outputs are not valid for FE (Gauss) + IF (p%BldMotionNodeLoc==BD_MESH_FE) then + InvalidOutput( BldNd_FFbxl ) = .true. + InvalidOutput( BldNd_FFbyl ) = .true. + InvalidOutput( BldNd_FFbzl ) = .true. + InvalidOutput( BldNd_MFbxl ) = .true. + InvalidOutput( BldNd_MFbyl ) = .true. + InvalidOutput( BldNd_MFbzl ) = .true. + InvalidOutput( BldNd_FFcxl ) = .true. + InvalidOutput( BldNd_FFcyl ) = .true. + InvalidOutput( BldNd_FFczl ) = .true. + InvalidOutput( BldNd_MFcxl ) = .true. + InvalidOutput( BldNd_MFcyl ) = .true. + InvalidOutput( BldNd_MFczl ) = .true. + InvalidOutput( BldNd_FFdxl ) = .true. + InvalidOutput( BldNd_FFdyl ) = .true. + InvalidOutput( BldNd_FFdzl ) = .true. + InvalidOutput( BldNd_MFdxl ) = .true. + InvalidOutput( BldNd_MFdyl ) = .true. + InvalidOutput( BldNd_MFdzl ) = .true. + InvalidOutput( BldNd_FFgxl ) = .true. + InvalidOutput( BldNd_FFgyl ) = .true. + InvalidOutput( BldNd_FFgzl ) = .true. + InvalidOutput( BldNd_MFgxl ) = .true. + InvalidOutput( BldNd_MFgyl ) = .true. + InvalidOutput( BldNd_MFgzl ) = .true. + InvalidOutput( BldNd_FFbxr ) = .true. + InvalidOutput( BldNd_FFbyr ) = .true. + InvalidOutput( BldNd_FFbzr ) = .true. + InvalidOutput( BldNd_MFbxr ) = .true. + InvalidOutput( BldNd_MFbyr ) = .true. + InvalidOutput( BldNd_MFbzr ) = .true. + InvalidOutput( BldNd_FFcxr ) = .true. + InvalidOutput( BldNd_FFcyr ) = .true. + InvalidOutput( BldNd_FFczr ) = .true. + InvalidOutput( BldNd_MFcxr ) = .true. + InvalidOutput( BldNd_MFcyr ) = .true. + InvalidOutput( BldNd_MFczr ) = .true. + InvalidOutput( BldNd_FFdxr ) = .true. + InvalidOutput( BldNd_FFdyr ) = .true. + InvalidOutput( BldNd_FFdzr ) = .true. + InvalidOutput( BldNd_MFdxr ) = .true. + InvalidOutput( BldNd_MFdyr ) = .true. + InvalidOutput( BldNd_MFdzr ) = .true. + InvalidOutput( BldNd_FFgxr ) = .true. + InvalidOutput( BldNd_FFgyr ) = .true. + InvalidOutput( BldNd_FFgzr ) = .true. + InvalidOutput( BldNd_MFgxr ) = .true. + InvalidOutput( BldNd_MFgyr ) = .true. + InvalidOutput( BldNd_MFgzr ) = .true. + InvalidOutput( BldNd_FFixl ) = .true. + InvalidOutput( BldNd_FFiyl ) = .true. + InvalidOutput( BldNd_FFizl ) = .true. + InvalidOutput( BldNd_MFixl ) = .true. + InvalidOutput( BldNd_MFiyl ) = .true. + InvalidOutput( BldNd_MFizl ) = .true. + InvalidOutput( BldNd_FFixr ) = .true. + InvalidOutput( BldNd_FFiyr ) = .true. + InvalidOutput( BldNd_FFizr ) = .true. + InvalidOutput( BldNd_MFixr ) = .true. + InvalidOutput( BldNd_MFiyr ) = .true. + InvalidOutput( BldNd_MFizr ) = .true. + END IF + IF (.NOT. (p%OutInputs .and. p%BldMotionNodeLoc/=BD_MESH_FE)) then + ! Distributed output channels not allowed yet as the mapping of the m%u_DistrLoad_at_y only exists for MESH_QP with p%OutInputs set to true + InvalidOutput( BldNd_DFxL ) = .true. + InvalidOutput( BldNd_DFyL ) = .true. + InvalidOutput( BldNd_DFzL ) = .true. + InvalidOutput( BldNd_DMxL ) = .true. + InvalidOutput( BldNd_DMyL ) = .true. + InvalidOutput( BldNd_DMzL ) = .true. + InvalidOutput( BldNd_DFxr ) = .true. + InvalidOutput( BldNd_DFyr ) = .true. + InvalidOutput( BldNd_DFzr ) = .true. + InvalidOutput( BldNd_DMxr ) = .true. + InvalidOutput( BldNd_DMyr ) = .true. + InvalidOutput( BldNd_DMzr ) = .true. + END IF + +! ................. End of validity checking ................. + + + !------------------------------------------------------------------------------------------------- + ! Allocate and set index, name, and units for the output channels + ! If a selected output channel is not available in this module, set error flag. + !------------------------------------------------------------------------------------------------- + + ALLOCATE ( p%BldNd_OutParam(1:p%BldNd_NumOuts) , STAT=ErrStat2 ) + IF ( ErrStat2 /= 0_IntKi ) THEN + CALL SetErrStat( ErrID_Fatal,"Error allocating memory for the BeamDyn BldNd_OutParam array.", ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + + + ! Set index, name, and units for all of the output channels. + ! If a selected output channel is not available by this module set ErrStat = ErrID_Warn. + + DO I = 1,p%BldNd_NumOuts + + p%BldNd_OutParam(I)%Name = "_"//BldNd_OutList(I) + OutListTmp = BldNd_OutList(I) + p%BldNd_OutParam(I)%SignM = 1 ! this won't be used + + CALL Conv2UC( OutListTmp ) ! Convert OutListTmp to upper case + + + Indx = IndexCharAry( OutListTmp(1:OutStrLenM1), ValidParamAry ) + + IF ( Indx > 0 ) THEN ! we found the channel name + IF ( InvalidOutput( ParamIndxAry(Indx) ) ) THEN ! but, it isn't valid for these settings + p%BldNd_OutParam(I)%Indx = 0 ! pick any valid channel (I just picked "Time=0" here because it's universal) + p%BldNd_OutParam(I)%Units = "INVALID" + p%BldNd_OutParam(I)%SignM = 0 + ELSE + p%BldNd_OutParam(I)%Indx = ParamIndxAry(Indx) + p%BldNd_OutParam(I)%Units = ParamUnitsAry(Indx) ! it's a valid output + END IF + ELSE ! this channel isn't valid + p%BldNd_OutParam(I)%Indx = 0 ! pick any valid channel (I just picked "Time=0" here because it's universal) + p%BldNd_OutParam(I)%Units = "INVALID" + p%BldNd_OutParam(I)%SignM = 0 ! multiply all results by zero + + CALL SetErrStat(ErrID_Fatal, TRIM(p%BldNd_OutParam(I)%Name)//" is not an available output channel.",ErrStat,ErrMsg,RoutineName) + END IF + + END DO + + RETURN +END SUBROUTINE BldNdOuts_SetOutParam +!---------------------------------------------------------------------------------------------------------------------------------- +!End of code generated by Matlab script +!********************************************************************************************************************************** + +END MODULE BeamDyn_BldNdOuts_IO diff --git a/modules/beamdyn/src/BeamDyn_IO.f90 b/modules/beamdyn/src/BeamDyn_IO.f90 index a4c06bf83c..92af5a918c 100644 --- a/modules/beamdyn/src/BeamDyn_IO.f90 +++ b/modules/beamdyn/src/BeamDyn_IO.f90 @@ -18,6 +18,7 @@ !> This module contains the input/output parameters and routines for the BeamDyn module. MODULE BeamDyn_IO + USE BeamDyn_BldNdOuts_IO USE BeamDyn_Types USE BeamDyn_Subs USE NWTC_Library @@ -564,6 +565,7 @@ SUBROUTINE BD_ReadPrimaryFile(InputFile,InputFileData,OutFileRoot,UnEc,ErrStat,E LOGICAL :: Echo ! Determines if an echo file should be written INTEGER(IntKi) :: IOS ! Temporary Error status CHARACTER(ErrMsgLen) :: ErrMsg2 ! Temporary Error message + CHARACTER(ErrMsgLen) :: ErrMsg_NoBldNdOuts ! Temporary Error message character(*), parameter :: RoutineName = 'BD_ReadPrimaryFile' CHARACTER(1024) :: PriPath ! Path name of the primary file @@ -586,6 +588,11 @@ SUBROUTINE BD_ReadPrimaryFile(InputFile,InputFileData,OutFileRoot,UnEc,ErrStat,E CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! Allocate array for holding the list of node outputs + CALL AllocAry( InputFileData%BldNd_OutList, BldNd_MaxOutPts, "BldNd_Outlist", ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL GetNewUnit(UnIn,ErrStat2,ErrMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL OpenFInpFile(UnIn,InputFile,ErrStat2,ErrMsg2) @@ -965,6 +972,55 @@ SUBROUTINE BD_ReadPrimaryFile(InputFile,InputFileData,OutFileRoot,UnEc,ErrStat,E !---------------------- END OF FILE ----------------------------------------- + + !----------- OUTLIST ----------------------------------------------------------- + ! In case there is something ill-formed in the additional nodal outputs section, we will simply ignore it. + ErrMsg_NoBldNdOuts='Nodal outputs section of BeamDyn input file not found or improperly formatted.' + InputFileData%BldNd_NumOuts = 0 ! Just in case we don't get an error but have no nodal outputs. + + + !----------- OUTLIST for BldNd ----------------------------------------------------------- + CALL ReadCom( UnIn, InputFile, 'Section Header: OutList for Blade node channels', ErrStat2, ErrMsg2, UnEc ) + IF ( ErrStat2 >= AbortErrLev ) THEN + InputFileData%BldNd_NumOuts = 0 + call wrscr( trim(ErrMsg_NoBldNdOuts) ) + CALL Cleanup() + RETURN + ENDIF + + ! Number of blade nodes to output: will modify this at some point for arrays + ! TODO: Parse this string into an array of nodes to output at (one idea is to set an array of boolean to T/F for which nodes to output). At present, we ignore it entirely. + CALL ReadVar( UnIn, InputFile, InputFileData%BldNd_BlOutNd_Str, 'BldNd_BlOutNd_Str', 'Which nodes to output node data on.'//TRIM(Num2Lstr(I)), ErrStat2, ErrMsg2, UnEc ) + IF ( ErrStat2 >= AbortErrLev ) THEN + InputFileData%BldNd_NumOuts = 0 + call wrscr( trim(ErrMsg_NoBldNdOuts) ) + CALL Cleanup() + RETURN + ENDIF + + + ! Section header for outlist + CALL ReadCom( UnIn, InputFile, 'Section Header: OutList', ErrStat2, ErrMsg2, UnEc ) + IF ( ErrStat2 >= AbortErrLev ) THEN + InputFileData%BldNd_NumOuts = 0 + CALL SetErrStat( ErrID_Warn, ErrMsg_NoBldNdOuts, ErrStat, ErrMsg, RoutineName ) + CALL Cleanup() + RETURN + ENDIF + + + ! OutList - List of user-requested output channels at each node(-): + CALL ReadOutputList ( UnIn, InputFile, InputFileData%BldNd_OutList, InputFileData%BldNd_NumOuts, 'BldNd_OutList', "List of user-requested output channels", ErrStat2, ErrMsg2, UnEc ) ! Routine in NWTC Subroutine Library + IF ( ErrStat2 >= AbortErrLev ) THEN + InputFileData%BldNd_NumOuts = 0 + call wrscr( trim(ErrMsg_NoBldNdOuts) ) + CALL Cleanup() + RETURN + ENDIF + + !---------------------- END OF FILE ----------------------------------------- + + call cleanup() return @@ -1317,8 +1373,14 @@ SUBROUTINE SetOutParam(OutList, p, ErrStat, ErrMsg ) InvalidOutput( PRatAct ) = .true. InvalidOutput( PAccAct ) = .true. END IF - - + + if (p%BldMotionNodeLoc /= BD_MESH_FE) then + DO I = 1,9 + InvalidOutput( NPFl(i,:) ) = .true. + InvalidOutput( NPMl(i,:) ) = .true. + END DO + end if + ! ................. End of validity checking ................. @@ -1567,7 +1629,7 @@ SUBROUTINE BD_ValidateInputData( InitInp, InputFileData, ErrStat, ErrMsg ) END SUBROUTINE BD_ValidateInputData !---------------------------------------------------------------------------------------------------------------------------------- !> this routine fills the AllOuts array, which is used to send data to the glue code to be written to an output file. -SUBROUTINE Calc_WriteOutput( p, AllOuts, y, m, ErrStat, ErrMsg ) +SUBROUTINE Calc_WriteOutput( p, AllOuts, y, m, ErrStat, ErrMsg, CalcWriteOutput ) TYPE(BD_ParameterType), INTENT(IN ) :: p !< The module parameters REAL(ReKi), INTENT(INOUT) :: AllOuts(0:) !< array of values to potentially write to file @@ -1575,6 +1637,7 @@ SUBROUTINE Calc_WriteOutput( p, AllOuts, y, m, ErrStat, ErrMsg ) TYPE(BD_MiscVarType), INTENT(INOUT) :: m !< misc/optimization variables (for computing mesh transfers) INTEGER(IntKi), INTENT( OUT) :: ErrStat !< The error status code CHARACTER(*), INTENT( OUT) :: ErrMsg !< The error message, if an error occurred + LOGICAL , INTENT(IN ) :: CalcWriteOutput !< flag that determines if we need to compute AllOuts (or just the reaction loads that get returned to ServoDyn) ! local variables CHARACTER(*), PARAMETER :: RoutineName = 'Calc_WriteOutput' @@ -1615,7 +1678,7 @@ SUBROUTINE Calc_WriteOutput( p, AllOuts, y, m, ErrStat, ErrMsg ) !------------------------- ! we don't need to calculate the rest of these values if we don't ask for WriteOutput channels ! (but we did need RootMxr and RootMyr) - if ( p%NumOuts <= 0 ) RETURN + if ( p%NumOuts <= 0 .or. .not. CalcWriteOutput) RETURN !------------------------- @@ -2046,6 +2109,14 @@ SUBROUTINE BD_PrintSum( p, x, m, InitInp, ErrStat, ErrMsg ) END DO + WRITE (UnSu,'(15x,A)') + WRITE (UnSu,'(15x,A)') + WRITE (UnSu,'(15x,A)') 'Requested Output Channels at each blade station:' + WRITE (UnSu,'(15x,A)') 'Col Parameter Units' + WRITE (UnSu,'(15x,A)') '---- --------- -----' + DO I = 1,p%BldNd_NumOuts + WRITE (UnSu,OutPFmt) I, p%BldNd_OutParam(I)%Name, p%BldNd_OutParam(I)%Units + END DO if ( p%analysis_type /= BD_STATIC_ANALYSIS ) then !dynamic analysis @@ -2241,7 +2312,7 @@ SUBROUTINE Init_Jacobian_y( p, y, InitOut, ErrStat, ErrMsg) ! determine how many outputs there are in the Jacobians p%Jac_ny = y%ReactionForce%NNodes * 6 & ! 3 forces + 3 moments at each node + y%BldMotion%NNodes * 18 & ! 6 displacements (translation, rotation) + 6 velocities + 6 accelerations at each node - + p%NumOuts ! WriteOutput values + + p%NumOuts + p%BldNd_TotNumOuts ! WriteOutput values ! get the names of the linearized outputs: @@ -2256,7 +2327,7 @@ SUBROUTINE Init_Jacobian_y( p, y, InitOut, ErrStat, ErrMsg) call PackLoadMesh_Names( y%ReactionForce, 'Reaction force', InitOut%LinNames_y, index_next) call PackMotionMesh_Names(y%BldMotion, 'Blade motion', InitOut%LinNames_y, index_next) - do i=1,p%NumOuts + do i=1,p%NumOuts + p%BldNd_TotNumOuts InitOut%LinNames_y(i+index_next-1) = trim(InitOut%WriteOutputHdr(i))//', '//trim(InitOut%WriteOutputUnt(i)) end do @@ -2282,6 +2353,22 @@ SUBROUTINE Init_Jacobian_y( p, y, InitOut, ErrStat, ErrMsg) InitOut%RotFrame_y(i+index_next-1) = AllOut( p%OutParam(i)%Indx ) end if end do + + + ! set outputs for all nodes out: + index_next = index_next + p%NumOuts + DO i=1,p%BldNd_NumOuts + ChannelName = p%BldNd_OutParam(i)%Name + call Conv2UC(ChannelName) + if ( ChannelName( LEN_TRIM(ChannelName):LEN_TRIM(ChannelName) ) == 'G') then ! channel is in global coordinate system + isRotating = .false. + else + isRotating = .true. + end if + InitOut%RotFrame_y(index_next : index_next+size(p%BldNd_BlOutNd)-1 ) = isRotating + index_next = index_next + size(p%BldNd_BlOutNd) + ENDDO + END SUBROUTINE Init_Jacobian_y !---------------------------------------------------------------------------------------------------------------------------------- @@ -2436,7 +2523,7 @@ SUBROUTINE Compute_dY(p, y_p, y_m, delta, dY) call PackLoadMesh_dY( y_p%ReactionForce, y_m%ReactionForce, dY, indx_first) call PackMotionMesh_dY(y_p%BldMotion, y_m%BldMotion, dY, indx_first) ! all 6 motion fields - do i=1,p%NumOuts + do i=1,p%NumOuts + p%BldNd_TotNumOuts dY(i+indx_first-1) = y_p%WriteOutput(i) - y_m%WriteOutput(i) end do diff --git a/modules/beamdyn/src/BeamDyn_Types.f90 b/modules/beamdyn/src/BeamDyn_Types.f90 index 8d2c275185..378cf40104 100644 --- a/modules/beamdyn/src/BeamDyn_Types.f90 +++ b/modules/beamdyn/src/BeamDyn_Types.f90 @@ -118,6 +118,10 @@ MODULE BeamDyn_Types CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: OutList !< List of user-requested output channels [-] LOGICAL :: SumPrint !< Print summary data to file? (.sum) [-] CHARACTER(20) :: OutFmt !< Format specifier [-] + INTEGER(IntKi) :: BldNd_NumOuts !< Number of requested output channels per blade node (BD_BldNdOuts) [-] + CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: BldNd_OutList !< List of user-requested output channels (BD_BldNdOuts) [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: BldNd_BlOutNd !< The blade nodes to actually output (BD_BldNdOuts) [-] + CHARACTER(1024) :: BldNd_BlOutNd_Str !< String to parse for the blade nodes to actually output (BD_BldNdOuts) [-] END TYPE BD_InputFile ! ======================= ! ========= BD_ContinuousStateType ======= @@ -202,6 +206,7 @@ MODULE BeamDyn_Types INTEGER(IntKi) :: NNodeOuts !< Number of nodes to output data to a file[0 - 9] [-] INTEGER(IntKi) , DIMENSION(1:9) :: OutNd !< Nodes whose values will be output [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NdIndx !< Index into BldMotion mesh (to number the nodes for output without using collocated nodes) [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: NdIndxInverse !< Index from BldMotion mesh to unique nodes (to number the nodes for output without using collocated nodes) [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: OutNd2NdElem !< To go from an output node number to a node/elem pair [-] CHARACTER(20) :: OutFmt !< Format specifier [-] LOGICAL :: UsePitchAct !< Whether to use a pitch actuator inside BeamDyn [(flag)] @@ -216,6 +221,10 @@ MODULE BeamDyn_Types LOGICAL :: tngt_stf_comp !< Flag to compare finite differenced and analytical tangent stifness [-] REAL(R8Ki) :: tngt_stf_pert !< Perturbation size for computing finite differenced tangent stiffness [-] REAL(R8Ki) :: tngt_stf_difftol !< When comparing tangent stiffness matrix, stop simulation if error greater than this [-] + INTEGER(IntKi) :: BldNd_NumOuts !< [BD_BldNdOuts] Number of requested output channels per blade node [-] + INTEGER(IntKi) :: BldNd_TotNumOuts !< [BD_BldNdOuts] Total number of requested output channels of blade node information (equal to BldNd_NumOuts * BldNd_BlOutNd) [-] + TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: BldNd_OutParam !< [BD_BldNdOuts] Names and units (and other characteristics) of all requested output parameters [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: BldNd_BlOutNd !< [BD_BldNdOuts] The blade nodes to actually output [-] REAL(R8Ki) , DIMENSION(:,:,:,:), ALLOCATABLE :: QPtw_Shp_Shp_Jac !< optimization variable: QPtw_Shp_Shp_Jac(idx_qp,i,j,nelem) = p%Shp(i,idx_qp)*p%Shp(j,idx_qp)*p%QPtWeight(idx_qp)*p%Jacobian(idx_qp,nelem) [-] REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: QPtw_Shp_ShpDer !< optimization variable: QPtw_Shp_ShpDer(idx_qp,i,j) = p%Shp(i,idx_qp)*p%ShpDer(j,idx_qp)*p%QPtWeight(idx_qp) [-] REAL(R8Ki) , DIMENSION(:,:,:,:), ALLOCATABLE :: QPtw_ShpDer_ShpDer_Jac !< optimization variable: QPtw_ShpDer_ShpDer_Jac(idx_qp,i,j,nelem) = p%ShpDer(i,idx_qp)*p%ShpDer(j,idx_qp)*p%QPtWeight(idx_qp)/p%Jacobian(idx_qp,nelem) [-] @@ -443,34 +452,56 @@ SUBROUTINE BD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%gravity))-1 ) = PACK(InData%gravity,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%gravity) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GlbPos))-1 ) = PACK(InData%GlbPos,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GlbPos) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%GlbRot))-1 ) = PACK(InData%GlbRot,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%GlbRot) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%RootDisp))-1 ) = PACK(InData%RootDisp,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%RootDisp) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%RootOri))-1 ) = PACK(InData%RootOri,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%RootOri) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RootVel))-1 ) = PACK(InData%RootVel,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RootVel) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%HubPos))-1 ) = PACK(InData%HubPos,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%HubPos) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%HubRot))-1 ) = PACK(InData%HubRot,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%HubRot) - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Linearize , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%DynamicSolve , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%InputFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO i1 = LBOUND(InData%gravity,1), UBOUND(InData%gravity,1) + ReKiBuf(Re_Xferred) = InData%gravity(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%GlbPos,1), UBOUND(InData%GlbPos,1) + ReKiBuf(Re_Xferred) = InData%GlbPos(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i2 = LBOUND(InData%GlbRot,2), UBOUND(InData%GlbRot,2) + DO i1 = LBOUND(InData%GlbRot,1), UBOUND(InData%GlbRot,1) + DbKiBuf(Db_Xferred) = InData%GlbRot(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + DO i1 = LBOUND(InData%RootDisp,1), UBOUND(InData%RootDisp,1) + DbKiBuf(Db_Xferred) = InData%RootDisp(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i2 = LBOUND(InData%RootOri,2), UBOUND(InData%RootOri,2) + DO i1 = LBOUND(InData%RootOri,1), UBOUND(InData%RootOri,1) + DbKiBuf(Db_Xferred) = InData%RootOri(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + DO i1 = LBOUND(InData%RootVel,1), UBOUND(InData%RootVel,1) + ReKiBuf(Re_Xferred) = InData%RootVel(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%HubPos,1), UBOUND(InData%HubPos,1) + ReKiBuf(Re_Xferred) = InData%HubPos(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i2 = LBOUND(InData%HubRot,2), UBOUND(InData%HubRot,2) + DO i1 = LBOUND(InData%HubRot,1), UBOUND(InData%HubRot,1) + DbKiBuf(Db_Xferred) = InData%HubRot(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + IntKiBuf(Int_Xferred) = TRANSFER(InData%Linearize, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%DynamicSolve, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE BD_PackInitInput SUBROUTINE BD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -486,12 +517,6 @@ SUBROUTINE BD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (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 @@ -509,112 +534,78 @@ SUBROUTINE BD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%InputFile) - OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%InputFile) + OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I i1_l = LBOUND(OutData%gravity,1) i1_u = UBOUND(OutData%gravity,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%gravity = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%gravity))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%gravity) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%gravity,1), UBOUND(OutData%gravity,1) + OutData%gravity(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%GlbPos,1) i1_u = UBOUND(OutData%GlbPos,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%GlbPos = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GlbPos))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GlbPos) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%GlbPos,1), UBOUND(OutData%GlbPos,1) + OutData%GlbPos(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%GlbRot,1) i1_u = UBOUND(OutData%GlbRot,1) i2_l = LBOUND(OutData%GlbRot,2) i2_u = UBOUND(OutData%GlbRot,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%GlbRot = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%GlbRot))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%GlbRot) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%GlbRot,2), UBOUND(OutData%GlbRot,2) + DO i1 = LBOUND(OutData%GlbRot,1), UBOUND(OutData%GlbRot,1) + OutData%GlbRot(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%RootDisp,1) i1_u = UBOUND(OutData%RootDisp,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%RootDisp = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%RootDisp))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%RootDisp) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%RootDisp,1), UBOUND(OutData%RootDisp,1) + OutData%RootDisp(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%RootOri,1) i1_u = UBOUND(OutData%RootOri,1) i2_l = LBOUND(OutData%RootOri,2) i2_u = UBOUND(OutData%RootOri,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%RootOri = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%RootOri))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%RootOri) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%RootOri,2), UBOUND(OutData%RootOri,2) + DO i1 = LBOUND(OutData%RootOri,1), UBOUND(OutData%RootOri,1) + OutData%RootOri(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%RootVel,1) i1_u = UBOUND(OutData%RootVel,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%RootVel = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RootVel))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RootVel) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%RootVel,1), UBOUND(OutData%RootVel,1) + OutData%RootVel(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%HubPos,1) i1_u = UBOUND(OutData%HubPos,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%HubPos = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%HubPos))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%HubPos) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%HubPos,1), UBOUND(OutData%HubPos,1) + OutData%HubPos(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%HubRot,1) i1_u = UBOUND(OutData%HubRot,1) i2_l = LBOUND(OutData%HubRot,2) i2_u = UBOUND(OutData%HubRot,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%HubRot = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%HubRot))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%HubRot) - DEALLOCATE(mask2) - OutData%Linearize = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%DynamicSolve = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(OutData%HubRot,2), UBOUND(OutData%HubRot,2) + DO i1 = LBOUND(OutData%HubRot,1), UBOUND(OutData%HubRot,1) + OutData%HubRot(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + OutData%Linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%Linearize) + Int_Xferred = Int_Xferred + 1 + OutData%DynamicSolve = TRANSFER(IntKiBuf(Int_Xferred), OutData%DynamicSolve) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE BD_UnPackInitInput SUBROUTINE BD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -964,12 +955,12 @@ SUBROUTINE BD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -981,12 +972,12 @@ SUBROUTINE BD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + 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) @@ -1029,11 +1020,15 @@ SUBROUTINE BD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%kp_coordinate,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%kp_coordinate)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%kp_coordinate))-1 ) = PACK(InData%kp_coordinate,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%kp_coordinate) + DO i2 = LBOUND(InData%kp_coordinate,2), UBOUND(InData%kp_coordinate,2) + DO i1 = LBOUND(InData%kp_coordinate,1), UBOUND(InData%kp_coordinate,1) + DbKiBuf(Db_Xferred) = InData%kp_coordinate(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%kp_total - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%kp_total + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%LinNames_y) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1044,12 +1039,12 @@ SUBROUTINE BD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_y,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%LinNames_y,1), UBOUND(InData%LinNames_y,1) + DO 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LinNames_x) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1061,12 +1056,12 @@ SUBROUTINE BD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_x,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%LinNames_x,1), UBOUND(InData%LinNames_x,1) + DO 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LinNames_u) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1078,12 +1073,12 @@ SUBROUTINE BD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_u,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%LinNames_u,1), UBOUND(InData%LinNames_u,1) + DO 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%RotFrame_y) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1095,8 +1090,10 @@ SUBROUTINE BD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_y,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RotFrame_y)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%RotFrame_y)-1 ) = TRANSFER(PACK( InData%RotFrame_y ,.TRUE.), IntKiBuf(1), SIZE(InData%RotFrame_y)) - Int_Xferred = Int_Xferred + SIZE(InData%RotFrame_y) + DO i1 = LBOUND(InData%RotFrame_y,1), UBOUND(InData%RotFrame_y,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_y(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%RotFrame_x) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1108,8 +1105,10 @@ SUBROUTINE BD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_x,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RotFrame_x)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%RotFrame_x)-1 ) = TRANSFER(PACK( InData%RotFrame_x ,.TRUE.), IntKiBuf(1), SIZE(InData%RotFrame_x)) - Int_Xferred = Int_Xferred + SIZE(InData%RotFrame_x) + 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 @@ -1121,8 +1120,10 @@ SUBROUTINE BD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_u,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RotFrame_u)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%RotFrame_u)-1 ) = TRANSFER(PACK( InData%RotFrame_u ,.TRUE.), IntKiBuf(1), SIZE(InData%RotFrame_u)) - Int_Xferred = Int_Xferred + SIZE(InData%RotFrame_u) + 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 @@ -1134,8 +1135,10 @@ SUBROUTINE BD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IsLoad_u,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%IsLoad_u)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%IsLoad_u)-1 ) = TRANSFER(PACK( InData%IsLoad_u ,.TRUE.), IntKiBuf(1), SIZE(InData%IsLoad_u)) - Int_Xferred = Int_Xferred + SIZE(InData%IsLoad_u) + 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 @@ -1147,8 +1150,10 @@ SUBROUTINE BD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DerivOrder_x,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DerivOrder_x)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%DerivOrder_x))-1 ) = PACK(InData%DerivOrder_x,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%DerivOrder_x) + DO i1 = LBOUND(InData%DerivOrder_x,1), UBOUND(InData%DerivOrder_x,1) + IntKiBuf(Int_Xferred) = InData%DerivOrder_x(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF END SUBROUTINE BD_PackInitOutput @@ -1165,12 +1170,6 @@ SUBROUTINE BD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -1199,19 +1198,12 @@ SUBROUTINE BD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated Int_Xferred = Int_Xferred + 1 @@ -1226,19 +1218,12 @@ SUBROUTINE BD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -1296,18 +1281,15 @@ SUBROUTINE BD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%kp_coordinate.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%kp_coordinate)>0) OutData%kp_coordinate = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%kp_coordinate))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%kp_coordinate) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%kp_coordinate,2), UBOUND(OutData%kp_coordinate,2) + DO i1 = LBOUND(OutData%kp_coordinate,1), UBOUND(OutData%kp_coordinate,1) + OutData%kp_coordinate(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF - OutData%kp_total = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%kp_total = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_y not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1321,19 +1303,12 @@ SUBROUTINE BD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%LinNames_y,1), UBOUND(OutData%LinNames_y,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_x not allocated Int_Xferred = Int_Xferred + 1 @@ -1348,19 +1323,12 @@ SUBROUTINE BD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_x.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%LinNames_x,1), UBOUND(OutData%LinNames_x,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_u not allocated Int_Xferred = Int_Xferred + 1 @@ -1375,19 +1343,12 @@ SUBROUTINE BD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%LinNames_u,1), UBOUND(OutData%LinNames_u,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_y not allocated Int_Xferred = Int_Xferred + 1 @@ -1402,15 +1363,10 @@ SUBROUTINE BD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%RotFrame_y)>0) OutData%RotFrame_y = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%RotFrame_y))-1 ), OutData%RotFrame_y), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%RotFrame_y) - DEALLOCATE(mask1) + 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 @@ -1425,15 +1381,10 @@ SUBROUTINE BD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_x.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%RotFrame_x)>0) OutData%RotFrame_x = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%RotFrame_x))-1 ), OutData%RotFrame_x), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%RotFrame_x) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%RotFrame_x,1), UBOUND(OutData%RotFrame_x,1) + OutData%RotFrame_x(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_x(i1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_u not allocated Int_Xferred = Int_Xferred + 1 @@ -1448,15 +1399,10 @@ SUBROUTINE BD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%RotFrame_u)>0) OutData%RotFrame_u = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%RotFrame_u))-1 ), OutData%RotFrame_u), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%RotFrame_u) - DEALLOCATE(mask1) + 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 @@ -1471,15 +1417,10 @@ SUBROUTINE BD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%IsLoad_u)>0) OutData%IsLoad_u = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%IsLoad_u))-1 ), OutData%IsLoad_u), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%IsLoad_u) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%IsLoad_u,1), UBOUND(OutData%IsLoad_u,1) + OutData%IsLoad_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsLoad_u(i1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DerivOrder_x not allocated Int_Xferred = Int_Xferred + 1 @@ -1494,15 +1435,10 @@ SUBROUTINE BD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%DerivOrder_x)>0) OutData%DerivOrder_x = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%DerivOrder_x))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%DerivOrder_x) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%DerivOrder_x,1), UBOUND(OutData%DerivOrder_x,1) + OutData%DerivOrder_x(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF END SUBROUTINE BD_UnPackInitOutput @@ -1674,10 +1610,10 @@ SUBROUTINE BD_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%station_total - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%format_index - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%station_total + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%format_index + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%station_eta) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1688,8 +1624,10 @@ SUBROUTINE BD_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%station_eta,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%station_eta)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%station_eta))-1 ) = PACK(InData%station_eta,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%station_eta) + DO i1 = LBOUND(InData%station_eta,1), UBOUND(InData%station_eta,1) + DbKiBuf(Db_Xferred) = InData%station_eta(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%stiff0) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1707,8 +1645,14 @@ SUBROUTINE BD_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%stiff0,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%stiff0)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%stiff0))-1 ) = PACK(InData%stiff0,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%stiff0) + DO i3 = LBOUND(InData%stiff0,3), UBOUND(InData%stiff0,3) + DO i2 = LBOUND(InData%stiff0,2), UBOUND(InData%stiff0,2) + DO i1 = LBOUND(InData%stiff0,1), UBOUND(InData%stiff0,1) + DbKiBuf(Db_Xferred) = InData%stiff0(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%mass0) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1726,13 +1670,21 @@ SUBROUTINE BD_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%mass0,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%mass0)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%mass0))-1 ) = PACK(InData%mass0,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%mass0) + DO i3 = LBOUND(InData%mass0,3), UBOUND(InData%mass0,3) + DO i2 = LBOUND(InData%mass0,2), UBOUND(InData%mass0,2) + DO i1 = LBOUND(InData%mass0,1), UBOUND(InData%mass0,1) + DbKiBuf(Db_Xferred) = InData%mass0(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%beta))-1 ) = PACK(InData%beta,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%beta) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%damp_flag - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%beta,1), UBOUND(InData%beta,1) + DbKiBuf(Db_Xferred) = InData%beta(i1) + Db_Xferred = Db_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%damp_flag + Int_Xferred = Int_Xferred + 1 END SUBROUTINE BD_PackBladeInputData SUBROUTINE BD_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1748,12 +1700,6 @@ SUBROUTINE BD_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (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 @@ -1770,10 +1716,10 @@ SUBROUTINE BD_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%station_total = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%format_index = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%station_total = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%format_index = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! station_eta not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1787,15 +1733,10 @@ SUBROUTINE BD_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%station_eta.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%station_eta)>0) OutData%station_eta = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%station_eta))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%station_eta) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%station_eta,1), UBOUND(OutData%station_eta,1) + OutData%station_eta(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! stiff0 not allocated Int_Xferred = Int_Xferred + 1 @@ -1816,15 +1757,14 @@ SUBROUTINE BD_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%stiff0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%stiff0)>0) OutData%stiff0 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%stiff0))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%stiff0) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%stiff0,3), UBOUND(OutData%stiff0,3) + DO i2 = LBOUND(OutData%stiff0,2), UBOUND(OutData%stiff0,2) + DO i1 = LBOUND(OutData%stiff0,1), UBOUND(OutData%stiff0,1) + OutData%stiff0(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! mass0 not allocated Int_Xferred = Int_Xferred + 1 @@ -1845,29 +1785,23 @@ SUBROUTINE BD_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%mass0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%mass0)>0) OutData%mass0 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%mass0))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%mass0) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%mass0,3), UBOUND(OutData%mass0,3) + DO i2 = LBOUND(OutData%mass0,2), UBOUND(OutData%mass0,2) + DO i1 = LBOUND(OutData%mass0,1), UBOUND(OutData%mass0,1) + OutData%mass0(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF i1_l = LBOUND(OutData%beta,1) i1_u = UBOUND(OutData%beta,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%beta = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%beta))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%beta) - DEALLOCATE(mask1) - OutData%damp_flag = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%beta,1), UBOUND(OutData%beta,1) + OutData%beta(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + OutData%damp_flag = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE BD_UnPackBladeInputData SUBROUTINE BD_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg ) @@ -1956,6 +1890,32 @@ SUBROUTINE BD_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrSt ENDIF DstInputFileData%SumPrint = SrcInputFileData%SumPrint DstInputFileData%OutFmt = SrcInputFileData%OutFmt + DstInputFileData%BldNd_NumOuts = SrcInputFileData%BldNd_NumOuts +IF (ALLOCATED(SrcInputFileData%BldNd_OutList)) THEN + i1_l = LBOUND(SrcInputFileData%BldNd_OutList,1) + i1_u = UBOUND(SrcInputFileData%BldNd_OutList,1) + IF (.NOT. ALLOCATED(DstInputFileData%BldNd_OutList)) THEN + ALLOCATE(DstInputFileData%BldNd_OutList(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%BldNd_OutList.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInputFileData%BldNd_OutList = SrcInputFileData%BldNd_OutList +ENDIF +IF (ALLOCATED(SrcInputFileData%BldNd_BlOutNd)) THEN + i1_l = LBOUND(SrcInputFileData%BldNd_BlOutNd,1) + i1_u = UBOUND(SrcInputFileData%BldNd_BlOutNd,1) + IF (.NOT. ALLOCATED(DstInputFileData%BldNd_BlOutNd)) THEN + ALLOCATE(DstInputFileData%BldNd_BlOutNd(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%BldNd_BlOutNd.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInputFileData%BldNd_BlOutNd = SrcInputFileData%BldNd_BlOutNd +ENDIF + DstInputFileData%BldNd_BlOutNd_Str = SrcInputFileData%BldNd_BlOutNd_Str END SUBROUTINE BD_CopyInputFile SUBROUTINE BD_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) @@ -1976,6 +1936,12 @@ SUBROUTINE BD_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) ENDIF IF (ALLOCATED(InputFileData%OutList)) THEN DEALLOCATE(InputFileData%OutList) +ENDIF +IF (ALLOCATED(InputFileData%BldNd_OutList)) THEN + DEALLOCATE(InputFileData%BldNd_OutList) +ENDIF +IF (ALLOCATED(InputFileData%BldNd_BlOutNd)) THEN + DEALLOCATE(InputFileData%BldNd_BlOutNd) ENDIF END SUBROUTINE BD_DestroyInputFile @@ -2076,6 +2042,18 @@ SUBROUTINE BD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg END IF Int_BufSz = Int_BufSz + 1 ! SumPrint Int_BufSz = Int_BufSz + 1*LEN(InData%OutFmt) ! OutFmt + Int_BufSz = Int_BufSz + 1 ! BldNd_NumOuts + Int_BufSz = Int_BufSz + 1 ! BldNd_OutList allocated yes/no + IF ( ALLOCATED(InData%BldNd_OutList) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! BldNd_OutList upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%BldNd_OutList)*LEN(InData%BldNd_OutList) ! BldNd_OutList + END IF + Int_BufSz = Int_BufSz + 1 ! BldNd_BlOutNd allocated yes/no + IF ( ALLOCATED(InData%BldNd_BlOutNd) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! BldNd_BlOutNd upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%BldNd_BlOutNd) ! BldNd_BlOutNd + END IF + Int_BufSz = Int_BufSz + 1*LEN(InData%BldNd_BlOutNd_Str) ! BldNd_BlOutNd_Str IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -2103,10 +2081,10 @@ SUBROUTINE BD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%member_total - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%kp_total - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%member_total + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%kp_total + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%kp_member) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2117,25 +2095,27 @@ SUBROUTINE BD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%kp_member,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%kp_member)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%kp_member))-1 ) = PACK(InData%kp_member,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%kp_member) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%order_elem - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%load_retries - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NRMax - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%quadrature - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%n_fact - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%refine - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%rhoinf - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DTBeam - Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(InData%kp_member,1), UBOUND(InData%kp_member,1) + IntKiBuf(Int_Xferred) = InData%kp_member(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IntKiBuf(Int_Xferred) = InData%order_elem + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%load_retries + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NRMax + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%quadrature + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%n_fact + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%refine + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%rhoinf + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DTBeam + Db_Xferred = Db_Xferred + 1 CALL BD_Packbladeinputdata( Re_Buf, Db_Buf, Int_Buf, InData%InpBl, ErrStat2, ErrMsg2, OnlySize ) ! InpBl CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2164,20 +2144,20 @@ SUBROUTINE BD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - DO I = 1, LEN(InData%BldFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%BldFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%UsePitchAct , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%QuasiStaticInit , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%stop_tol - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%tngt_stf_pert - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%tngt_stf_difftol - Db_Xferred = Db_Xferred + 1 + DO I = 1, LEN(InData%BldFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%BldFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%UsePitchAct, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%QuasiStaticInit, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%stop_tol + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%tngt_stf_pert + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%tngt_stf_difftol + Db_Xferred = Db_Xferred + 1 IF ( .NOT. ALLOCATED(InData%kp_coordinate) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2191,31 +2171,37 @@ SUBROUTINE BD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%kp_coordinate,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%kp_coordinate)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%kp_coordinate))-1 ) = PACK(InData%kp_coordinate,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%kp_coordinate) - END IF - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%pitchJ - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%pitchK - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%pitchC - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Echo , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%RotStates , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%RelStates , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%tngt_stf_fd , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%tngt_stf_comp , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NNodeOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%OutNd))-1 ) = PACK(InData%OutNd,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%OutNd) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(InData%kp_coordinate,2), UBOUND(InData%kp_coordinate,2) + DO i1 = LBOUND(InData%kp_coordinate,1), UBOUND(InData%kp_coordinate,1) + DbKiBuf(Db_Xferred) = InData%kp_coordinate(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + DbKiBuf(Db_Xferred) = InData%pitchJ + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%pitchK + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%pitchC + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%Echo, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%RotStates, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%RelStates, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%tngt_stf_fd, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%tngt_stf_comp, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NNodeOuts + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%OutNd,1), UBOUND(InData%OutNd,1) + IntKiBuf(Int_Xferred) = InData%OutNd(i1) + Int_Xferred = Int_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%OutList) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2226,19 +2212,57 @@ SUBROUTINE BD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutList,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) + DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) DO I = 1, LEN(InData%OutList) IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%SumPrint , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%SumPrint, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%OutFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%BldNd_NumOuts + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%BldNd_OutList) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BldNd_OutList,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldNd_OutList,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%BldNd_OutList,1), UBOUND(InData%BldNd_OutList,1) + DO I = 1, LEN(InData%BldNd_OutList) + IntKiBuf(Int_Xferred) = ICHAR(InData%BldNd_OutList(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 END DO ! I + END DO + END IF + IF ( .NOT. ALLOCATED(InData%BldNd_BlOutNd) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BldNd_BlOutNd,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldNd_BlOutNd,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%BldNd_BlOutNd,1), UBOUND(InData%BldNd_BlOutNd,1) + IntKiBuf(Int_Xferred) = InData%BldNd_BlOutNd(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + DO I = 1, LEN(InData%BldNd_BlOutNd_Str) + IntKiBuf(Int_Xferred) = ICHAR(InData%BldNd_BlOutNd_Str(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE BD_PackInputFile SUBROUTINE BD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2254,12 +2278,6 @@ SUBROUTINE BD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -2275,10 +2293,10 @@ SUBROUTINE BD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%member_total = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%kp_total = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%member_total = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%kp_total = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! kp_member not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -2292,32 +2310,27 @@ SUBROUTINE BD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%kp_member.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%kp_member)>0) OutData%kp_member = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%kp_member))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%kp_member) - DEALLOCATE(mask1) - END IF - OutData%order_elem = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%load_retries = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NRMax = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%quadrature = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%n_fact = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%refine = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%rhoinf = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%DTBeam = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(OutData%kp_member,1), UBOUND(OutData%kp_member,1) + OutData%kp_member(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + OutData%order_elem = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%load_retries = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NRMax = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%quadrature = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%n_fact = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%refine = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%rhoinf = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%DTBeam = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -2358,20 +2371,20 @@ SUBROUTINE BD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - DO I = 1, LEN(OutData%BldFile) - OutData%BldFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%UsePitchAct = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%QuasiStaticInit = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%stop_tol = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%tngt_stf_pert = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%tngt_stf_difftol = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 + DO I = 1, LEN(OutData%BldFile) + OutData%BldFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%UsePitchAct = TRANSFER(IntKiBuf(Int_Xferred), OutData%UsePitchAct) + Int_Xferred = Int_Xferred + 1 + OutData%QuasiStaticInit = TRANSFER(IntKiBuf(Int_Xferred), OutData%QuasiStaticInit) + Int_Xferred = Int_Xferred + 1 + OutData%stop_tol = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%tngt_stf_pert = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%tngt_stf_difftol = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! kp_coordinate not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -2388,47 +2401,39 @@ SUBROUTINE BD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%kp_coordinate.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%kp_coordinate)>0) OutData%kp_coordinate = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%kp_coordinate))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%kp_coordinate) - DEALLOCATE(mask2) - END IF - OutData%pitchJ = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%pitchK = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%pitchC = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%Echo = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%RotStates = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%RelStates = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%tngt_stf_fd = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%tngt_stf_comp = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NNodeOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(OutData%kp_coordinate,2), UBOUND(OutData%kp_coordinate,2) + DO i1 = LBOUND(OutData%kp_coordinate,1), UBOUND(OutData%kp_coordinate,1) + OutData%kp_coordinate(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + OutData%pitchJ = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%pitchK = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%pitchC = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%Echo = TRANSFER(IntKiBuf(Int_Xferred), OutData%Echo) + Int_Xferred = Int_Xferred + 1 + OutData%RotStates = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotStates) + Int_Xferred = Int_Xferred + 1 + OutData%RelStates = TRANSFER(IntKiBuf(Int_Xferred), OutData%RelStates) + Int_Xferred = Int_Xferred + 1 + OutData%tngt_stf_fd = TRANSFER(IntKiBuf(Int_Xferred), OutData%tngt_stf_fd) + Int_Xferred = Int_Xferred + 1 + OutData%tngt_stf_comp = TRANSFER(IntKiBuf(Int_Xferred), OutData%tngt_stf_comp) + Int_Xferred = Int_Xferred + 1 + OutData%NNodeOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%OutNd,1) i1_u = UBOUND(OutData%OutNd,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%OutNd = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%OutNd))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%OutNd) - DEALLOCATE(mask1) - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%OutNd,1), UBOUND(OutData%OutNd,1) + OutData%OutNd(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutList not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -2442,26 +2447,63 @@ SUBROUTINE BD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) + DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) + DO I = 1, LEN(OutData%OutList) + OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + OutData%SumPrint = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumPrint) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%OutFmt) + OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%BldNd_NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldNd_OutList not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BldNd_OutList)) DEALLOCATE(OutData%BldNd_OutList) + ALLOCATE(OutData%BldNd_OutList(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_OutList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) - DO I = 1, LEN(OutData%OutList) - OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%BldNd_OutList,1), UBOUND(OutData%BldNd_OutList,1) + DO I = 1, LEN(OutData%BldNd_OutList) + OutData%BldNd_OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) - END IF - OutData%SumPrint = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutFmt) - OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldNd_BlOutNd not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BldNd_BlOutNd)) DEALLOCATE(OutData%BldNd_BlOutNd) + ALLOCATE(OutData%BldNd_BlOutNd(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_BlOutNd.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%BldNd_BlOutNd,1), UBOUND(OutData%BldNd_BlOutNd,1) + OutData%BldNd_BlOutNd(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + DO I = 1, LEN(OutData%BldNd_BlOutNd_Str) + OutData%BldNd_BlOutNd_Str(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE BD_UnPackInputFile SUBROUTINE BD_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) @@ -2612,8 +2654,12 @@ SUBROUTINE BD_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%q,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%q)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%q))-1 ) = PACK(InData%q,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%q) + DO i2 = LBOUND(InData%q,2), UBOUND(InData%q,2) + DO i1 = LBOUND(InData%q,1), UBOUND(InData%q,1) + DbKiBuf(Db_Xferred) = InData%q(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%dqdt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2628,8 +2674,12 @@ SUBROUTINE BD_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dqdt,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%dqdt)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%dqdt))-1 ) = PACK(InData%dqdt,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%dqdt) + DO i2 = LBOUND(InData%dqdt,2), UBOUND(InData%dqdt,2) + DO i1 = LBOUND(InData%dqdt,1), UBOUND(InData%dqdt,1) + DbKiBuf(Db_Xferred) = InData%dqdt(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF END SUBROUTINE BD_PackContState @@ -2646,12 +2696,6 @@ SUBROUTINE BD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -2683,15 +2727,12 @@ SUBROUTINE BD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%q.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%q)>0) OutData%q = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%q))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%q) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%q,2), UBOUND(OutData%q,2) + DO i1 = LBOUND(OutData%q,1), UBOUND(OutData%q,1) + OutData%q(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dqdt not allocated Int_Xferred = Int_Xferred + 1 @@ -2709,15 +2750,12 @@ SUBROUTINE BD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dqdt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%dqdt)>0) OutData%dqdt = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%dqdt))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%dqdt) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%dqdt,2), UBOUND(OutData%dqdt,2) + DO i1 = LBOUND(OutData%dqdt,1), UBOUND(OutData%dqdt,1) + OutData%dqdt(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF END SUBROUTINE BD_UnPackContState @@ -2814,10 +2852,10 @@ SUBROUTINE BD_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%thetaP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%thetaPD - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%thetaP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%thetaPD + Re_Xferred = Re_Xferred + 1 END SUBROUTINE BD_PackDiscState SUBROUTINE BD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2833,12 +2871,6 @@ SUBROUTINE BD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'BD_UnPackDiscState' @@ -2852,10 +2884,10 @@ SUBROUTINE BD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%thetaP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%thetaPD = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%thetaP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%thetaPD = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE BD_UnPackDiscState SUBROUTINE BD_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) @@ -2949,8 +2981,8 @@ SUBROUTINE BD_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyConstrState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE BD_PackConstrState SUBROUTINE BD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2966,12 +2998,6 @@ SUBROUTINE BD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'BD_UnPackConstrState' @@ -2985,8 +3011,8 @@ SUBROUTINE BD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyConstrState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyConstrState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE BD_UnPackConstrState SUBROUTINE BD_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -3141,8 +3167,12 @@ SUBROUTINE BD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%acc,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%acc)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%acc))-1 ) = PACK(InData%acc,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%acc) + DO i2 = LBOUND(InData%acc,2), UBOUND(InData%acc,2) + DO i1 = LBOUND(InData%acc,1), UBOUND(InData%acc,1) + DbKiBuf(Db_Xferred) = InData%acc(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%xcc) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3157,13 +3187,17 @@ SUBROUTINE BD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xcc,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%xcc)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%xcc))-1 ) = PACK(InData%xcc,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%xcc) + DO i2 = LBOUND(InData%xcc,2), UBOUND(InData%xcc,2) + DO i1 = LBOUND(InData%xcc,1), UBOUND(InData%xcc,1) + DbKiBuf(Db_Xferred) = InData%xcc(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%InitAcc , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%RunQuasiStaticInit , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%InitAcc, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%RunQuasiStaticInit, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE BD_PackOtherState SUBROUTINE BD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -3179,12 +3213,6 @@ SUBROUTINE BD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -3216,15 +3244,12 @@ SUBROUTINE BD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%acc.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%acc)>0) OutData%acc = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%acc))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%acc) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%acc,2), UBOUND(OutData%acc,2) + DO i1 = LBOUND(OutData%acc,1), UBOUND(OutData%acc,1) + OutData%acc(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xcc not allocated Int_Xferred = Int_Xferred + 1 @@ -3242,20 +3267,17 @@ SUBROUTINE BD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xcc.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%xcc)>0) OutData%xcc = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%xcc))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%xcc) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%xcc,2), UBOUND(OutData%xcc,2) + DO i1 = LBOUND(OutData%xcc,1), UBOUND(OutData%xcc,1) + OutData%xcc(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF - OutData%InitAcc = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%RunQuasiStaticInit = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%InitAcc = TRANSFER(IntKiBuf(Int_Xferred), OutData%InitAcc) + Int_Xferred = Int_Xferred + 1 + OutData%RunQuasiStaticInit = TRANSFER(IntKiBuf(Int_Xferred), OutData%RunQuasiStaticInit) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE BD_UnPackOtherState SUBROUTINE BD_CopyqpParam( SrcqpParamData, DstqpParamData, CtrlCode, ErrStat, ErrMsg ) @@ -3409,8 +3431,12 @@ SUBROUTINE BD_PackqpParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%mmm,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%mmm)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%mmm))-1 ) = PACK(InData%mmm,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%mmm) + DO i2 = LBOUND(InData%mmm,2), UBOUND(InData%mmm,2) + DO i1 = LBOUND(InData%mmm,1), UBOUND(InData%mmm,1) + DbKiBuf(Db_Xferred) = InData%mmm(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%mEta) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3428,8 +3454,14 @@ SUBROUTINE BD_PackqpParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%mEta,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%mEta)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%mEta))-1 ) = PACK(InData%mEta,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%mEta) + DO i3 = LBOUND(InData%mEta,3), UBOUND(InData%mEta,3) + DO i2 = LBOUND(InData%mEta,2), UBOUND(InData%mEta,2) + DO i1 = LBOUND(InData%mEta,1), UBOUND(InData%mEta,1) + DbKiBuf(Db_Xferred) = InData%mEta(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF END SUBROUTINE BD_PackqpParam @@ -3446,12 +3478,6 @@ SUBROUTINE BD_UnPackqpParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (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 @@ -3484,15 +3510,12 @@ SUBROUTINE BD_UnPackqpParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%mmm.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%mmm)>0) OutData%mmm = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%mmm))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%mmm) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%mmm,2), UBOUND(OutData%mmm,2) + DO i1 = LBOUND(OutData%mmm,1), UBOUND(OutData%mmm,1) + OutData%mmm(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! mEta not allocated Int_Xferred = Int_Xferred + 1 @@ -3513,15 +3536,14 @@ SUBROUTINE BD_UnPackqpParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%mEta.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%mEta)>0) OutData%mEta = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%mEta))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%mEta) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%mEta,3), UBOUND(OutData%mEta,3) + DO i2 = LBOUND(OutData%mEta,2), UBOUND(OutData%mEta,2) + DO i1 = LBOUND(OutData%mEta,1), UBOUND(OutData%mEta,1) + OutData%mEta(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF END SUBROUTINE BD_UnPackqpParam @@ -3819,6 +3841,18 @@ SUBROUTINE BD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) END IF DstParamData%NdIndx = SrcParamData%NdIndx ENDIF +IF (ALLOCATED(SrcParamData%NdIndxInverse)) THEN + i1_l = LBOUND(SrcParamData%NdIndxInverse,1) + i1_u = UBOUND(SrcParamData%NdIndxInverse,1) + IF (.NOT. ALLOCATED(DstParamData%NdIndxInverse)) THEN + ALLOCATE(DstParamData%NdIndxInverse(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%NdIndxInverse.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%NdIndxInverse = SrcParamData%NdIndxInverse +ENDIF IF (ALLOCATED(SrcParamData%OutNd2NdElem)) THEN i1_l = LBOUND(SrcParamData%OutNd2NdElem,1) i1_u = UBOUND(SrcParamData%OutNd2NdElem,1) @@ -3848,6 +3882,36 @@ SUBROUTINE BD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) DstParamData%tngt_stf_comp = SrcParamData%tngt_stf_comp DstParamData%tngt_stf_pert = SrcParamData%tngt_stf_pert DstParamData%tngt_stf_difftol = SrcParamData%tngt_stf_difftol + DstParamData%BldNd_NumOuts = SrcParamData%BldNd_NumOuts + DstParamData%BldNd_TotNumOuts = SrcParamData%BldNd_TotNumOuts +IF (ALLOCATED(SrcParamData%BldNd_OutParam)) THEN + i1_l = LBOUND(SrcParamData%BldNd_OutParam,1) + i1_u = UBOUND(SrcParamData%BldNd_OutParam,1) + IF (.NOT. ALLOCATED(DstParamData%BldNd_OutParam)) THEN + ALLOCATE(DstParamData%BldNd_OutParam(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldNd_OutParam.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcParamData%BldNd_OutParam,1), UBOUND(SrcParamData%BldNd_OutParam,1) + CALL NWTC_Library_Copyoutparmtype( SrcParamData%BldNd_OutParam(i1), DstParamData%BldNd_OutParam(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcParamData%BldNd_BlOutNd)) THEN + i1_l = LBOUND(SrcParamData%BldNd_BlOutNd,1) + i1_u = UBOUND(SrcParamData%BldNd_BlOutNd,1) + IF (.NOT. ALLOCATED(DstParamData%BldNd_BlOutNd)) THEN + ALLOCATE(DstParamData%BldNd_BlOutNd(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldNd_BlOutNd.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstParamData%BldNd_BlOutNd = SrcParamData%BldNd_BlOutNd +ENDIF IF (ALLOCATED(SrcParamData%QPtw_Shp_Shp_Jac)) THEN i1_l = LBOUND(SrcParamData%QPtw_Shp_Shp_Jac,1) i1_u = UBOUND(SrcParamData%QPtw_Shp_Shp_Jac,1) @@ -4040,10 +4104,22 @@ SUBROUTINE BD_DestroyParam( ParamData, ErrStat, ErrMsg ) IF (ALLOCATED(ParamData%NdIndx)) THEN DEALLOCATE(ParamData%NdIndx) ENDIF +IF (ALLOCATED(ParamData%NdIndxInverse)) THEN + DEALLOCATE(ParamData%NdIndxInverse) +ENDIF IF (ALLOCATED(ParamData%OutNd2NdElem)) THEN DEALLOCATE(ParamData%OutNd2NdElem) ENDIF CALL BD_Destroyqpparam( ParamData%qp, ErrStat, ErrMsg ) +IF (ALLOCATED(ParamData%BldNd_OutParam)) THEN +DO i1 = LBOUND(ParamData%BldNd_OutParam,1), UBOUND(ParamData%BldNd_OutParam,1) + CALL NWTC_Library_Destroyoutparmtype( ParamData%BldNd_OutParam(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(ParamData%BldNd_OutParam) +ENDIF +IF (ALLOCATED(ParamData%BldNd_BlOutNd)) THEN + DEALLOCATE(ParamData%BldNd_BlOutNd) +ENDIF IF (ALLOCATED(ParamData%QPtw_Shp_Shp_Jac)) THEN DEALLOCATE(ParamData%QPtw_Shp_Shp_Jac) ENDIF @@ -4241,6 +4317,11 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Int_BufSz = Int_BufSz + 2*1 ! NdIndx upper/lower bounds for each dimension Int_BufSz = Int_BufSz + SIZE(InData%NdIndx) ! NdIndx END IF + Int_BufSz = Int_BufSz + 1 ! NdIndxInverse allocated yes/no + IF ( ALLOCATED(InData%NdIndxInverse) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! NdIndxInverse upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%NdIndxInverse) ! NdIndxInverse + END IF Int_BufSz = Int_BufSz + 1 ! OutNd2NdElem allocated yes/no IF ( ALLOCATED(InData%OutNd2NdElem) ) THEN Int_BufSz = Int_BufSz + 2*2 ! OutNd2NdElem upper/lower bounds for each dimension @@ -4275,7 +4356,37 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Int_BufSz = Int_BufSz + 1 ! tngt_stf_comp Db_BufSz = Db_BufSz + 1 ! tngt_stf_pert Db_BufSz = Db_BufSz + 1 ! tngt_stf_difftol - Int_BufSz = Int_BufSz + 1 ! QPtw_Shp_Shp_Jac allocated yes/no + Int_BufSz = Int_BufSz + 1 ! BldNd_NumOuts + Int_BufSz = Int_BufSz + 1 ! BldNd_TotNumOuts + Int_BufSz = Int_BufSz + 1 ! BldNd_OutParam allocated yes/no + IF ( ALLOCATED(InData%BldNd_OutParam) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! BldNd_OutParam upper/lower bounds for each dimension + DO i1 = LBOUND(InData%BldNd_OutParam,1), UBOUND(InData%BldNd_OutParam,1) + Int_BufSz = Int_BufSz + 3 ! BldNd_OutParam: size of buffers for each call to pack subtype + CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%BldNd_OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BldNd_OutParam + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! BldNd_OutParam + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! BldNd_OutParam + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! BldNd_OutParam + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! BldNd_BlOutNd allocated yes/no + IF ( ALLOCATED(InData%BldNd_BlOutNd) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! BldNd_BlOutNd upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%BldNd_BlOutNd) ! BldNd_BlOutNd + END IF + Int_BufSz = Int_BufSz + 1 ! QPtw_Shp_Shp_Jac allocated yes/no IF ( ALLOCATED(InData%QPtw_Shp_Shp_Jac) ) THEN Int_BufSz = Int_BufSz + 2*4 ! QPtw_Shp_Shp_Jac upper/lower bounds for each dimension Db_BufSz = Db_BufSz + SIZE(InData%QPtw_Shp_Shp_Jac) ! QPtw_Shp_Shp_Jac @@ -4347,12 +4458,14 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%dt - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%coef))-1 ) = PACK(InData%coef,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%coef) - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%rhoinf - Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%dt + Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(InData%coef,1), UBOUND(InData%coef,1) + DbKiBuf(Db_Xferred) = InData%coef(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DbKiBuf(Db_Xferred) = InData%rhoinf + Db_Xferred = Db_Xferred + 1 IF ( .NOT. ALLOCATED(InData%uuN0) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4369,8 +4482,14 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uuN0,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%uuN0)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%uuN0))-1 ) = PACK(InData%uuN0,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%uuN0) + DO i3 = LBOUND(InData%uuN0,3), UBOUND(InData%uuN0,3) + DO i2 = LBOUND(InData%uuN0,2), UBOUND(InData%uuN0,2) + DO i1 = LBOUND(InData%uuN0,1), UBOUND(InData%uuN0,1) + DbKiBuf(Db_Xferred) = InData%uuN0(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Stif0_QP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4388,8 +4507,14 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Stif0_QP,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Stif0_QP)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Stif0_QP))-1 ) = PACK(InData%Stif0_QP,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Stif0_QP) + DO i3 = LBOUND(InData%Stif0_QP,3), UBOUND(InData%Stif0_QP,3) + DO i2 = LBOUND(InData%Stif0_QP,2), UBOUND(InData%Stif0_QP,2) + DO i1 = LBOUND(InData%Stif0_QP,1), UBOUND(InData%Stif0_QP,1) + DbKiBuf(Db_Xferred) = InData%Stif0_QP(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Mass0_QP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4407,11 +4532,19 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Mass0_QP,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Mass0_QP)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Mass0_QP))-1 ) = PACK(InData%Mass0_QP,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Mass0_QP) + DO i3 = LBOUND(InData%Mass0_QP,3), UBOUND(InData%Mass0_QP,3) + DO i2 = LBOUND(InData%Mass0_QP,2), UBOUND(InData%Mass0_QP,2) + DO i1 = LBOUND(InData%Mass0_QP,1), UBOUND(InData%Mass0_QP,1) + DbKiBuf(Db_Xferred) = InData%Mass0_QP(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%gravity))-1 ) = PACK(InData%gravity,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%gravity) + DO i1 = LBOUND(InData%gravity,1), UBOUND(InData%gravity,1) + DbKiBuf(Db_Xferred) = InData%gravity(i1) + Db_Xferred = Db_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%segment_eta) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4422,8 +4555,10 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%segment_eta,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%segment_eta)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%segment_eta))-1 ) = PACK(InData%segment_eta,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%segment_eta) + DO i1 = LBOUND(InData%segment_eta,1), UBOUND(InData%segment_eta,1) + DbKiBuf(Db_Xferred) = InData%segment_eta(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%member_eta) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4435,27 +4570,45 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%member_eta,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%member_eta)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%member_eta))-1 ) = PACK(InData%member_eta,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%member_eta) - END IF - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%blade_length - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%blade_mass - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%blade_CG))-1 ) = PACK(InData%blade_CG,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%blade_CG) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%blade_IN))-1 ) = PACK(InData%blade_IN,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%blade_IN) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%beta))-1 ) = PACK(InData%beta,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%beta) - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%tol - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%GlbPos))-1 ) = PACK(InData%GlbPos,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%GlbPos) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%GlbRot))-1 ) = PACK(InData%GlbRot,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%GlbRot) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Glb_crv))-1 ) = PACK(InData%Glb_crv,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Glb_crv) + DO i1 = LBOUND(InData%member_eta,1), UBOUND(InData%member_eta,1) + DbKiBuf(Db_Xferred) = InData%member_eta(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + DbKiBuf(Db_Xferred) = InData%blade_length + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%blade_mass + Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(InData%blade_CG,1), UBOUND(InData%blade_CG,1) + DbKiBuf(Db_Xferred) = InData%blade_CG(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i2 = LBOUND(InData%blade_IN,2), UBOUND(InData%blade_IN,2) + DO i1 = LBOUND(InData%blade_IN,1), UBOUND(InData%blade_IN,1) + DbKiBuf(Db_Xferred) = InData%blade_IN(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + DO i1 = LBOUND(InData%beta,1), UBOUND(InData%beta,1) + DbKiBuf(Db_Xferred) = InData%beta(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DbKiBuf(Db_Xferred) = InData%tol + Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(InData%GlbPos,1), UBOUND(InData%GlbPos,1) + DbKiBuf(Db_Xferred) = InData%GlbPos(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i2 = LBOUND(InData%GlbRot,2), UBOUND(InData%GlbRot,2) + DO i1 = LBOUND(InData%GlbRot,1), UBOUND(InData%GlbRot,1) + DbKiBuf(Db_Xferred) = InData%GlbRot(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + DO i1 = LBOUND(InData%Glb_crv,1), UBOUND(InData%Glb_crv,1) + DbKiBuf(Db_Xferred) = InData%Glb_crv(i1) + Db_Xferred = Db_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%QPtN) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4466,8 +4619,10 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtN,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%QPtN)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%QPtN))-1 ) = PACK(InData%QPtN,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%QPtN) + DO i1 = LBOUND(InData%QPtN,1), UBOUND(InData%QPtN,1) + DbKiBuf(Db_Xferred) = InData%QPtN(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%QPtWeight) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4479,8 +4634,10 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtWeight,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%QPtWeight)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%QPtWeight))-1 ) = PACK(InData%QPtWeight,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%QPtWeight) + DO i1 = LBOUND(InData%QPtWeight,1), UBOUND(InData%QPtWeight,1) + DbKiBuf(Db_Xferred) = InData%QPtWeight(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%Shp) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4495,8 +4652,12 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Shp,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Shp)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Shp))-1 ) = PACK(InData%Shp,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Shp) + DO i2 = LBOUND(InData%Shp,2), UBOUND(InData%Shp,2) + DO i1 = LBOUND(InData%Shp,1), UBOUND(InData%Shp,1) + DbKiBuf(Db_Xferred) = InData%Shp(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%ShpDer) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4511,8 +4672,12 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ShpDer,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ShpDer)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%ShpDer))-1 ) = PACK(InData%ShpDer,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%ShpDer) + DO i2 = LBOUND(InData%ShpDer,2), UBOUND(InData%ShpDer,2) + DO i1 = LBOUND(InData%ShpDer,1), UBOUND(InData%ShpDer,1) + DbKiBuf(Db_Xferred) = InData%ShpDer(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Jacobian) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4527,8 +4692,12 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jacobian,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Jacobian)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Jacobian))-1 ) = PACK(InData%Jacobian,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Jacobian) + DO i2 = LBOUND(InData%Jacobian,2), UBOUND(InData%Jacobian,2) + DO i1 = LBOUND(InData%Jacobian,1), UBOUND(InData%Jacobian,1) + DbKiBuf(Db_Xferred) = InData%Jacobian(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%uu0) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4546,8 +4715,14 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uu0,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%uu0)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%uu0))-1 ) = PACK(InData%uu0,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%uu0) + DO i3 = LBOUND(InData%uu0,3), UBOUND(InData%uu0,3) + DO i2 = LBOUND(InData%uu0,2), UBOUND(InData%uu0,2) + DO i1 = LBOUND(InData%uu0,1), UBOUND(InData%uu0,1) + DbKiBuf(Db_Xferred) = InData%uu0(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%rrN0) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4565,8 +4740,14 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rrN0,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%rrN0)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rrN0))-1 ) = PACK(InData%rrN0,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rrN0) + DO i3 = LBOUND(InData%rrN0,3), UBOUND(InData%rrN0,3) + DO i2 = LBOUND(InData%rrN0,2), UBOUND(InData%rrN0,2) + DO i1 = LBOUND(InData%rrN0,1), UBOUND(InData%rrN0,1) + DbKiBuf(Db_Xferred) = InData%rrN0(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%E10) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4584,8 +4765,14 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%E10,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%E10)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%E10))-1 ) = PACK(InData%E10,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%E10) + DO i3 = LBOUND(InData%E10,3), UBOUND(InData%E10,3) + DO i2 = LBOUND(InData%E10,2), UBOUND(InData%E10,2) + DO i1 = LBOUND(InData%E10,1), UBOUND(InData%E10,1) + DbKiBuf(Db_Xferred) = InData%E10(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%SP_Coef) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4603,11 +4790,17 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SP_Coef,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%SP_Coef)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%SP_Coef))-1 ) = PACK(InData%SP_Coef,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%SP_Coef) + DO i3 = LBOUND(InData%SP_Coef,3), UBOUND(InData%SP_Coef,3) + DO i2 = LBOUND(InData%SP_Coef,2), UBOUND(InData%SP_Coef,2) + DO i1 = LBOUND(InData%SP_Coef,1), UBOUND(InData%SP_Coef,1) + DbKiBuf(Db_Xferred) = InData%SP_Coef(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%nodes_per_elem - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nodes_per_elem + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%node_elem_idx) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4621,41 +4814,45 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%node_elem_idx,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%node_elem_idx)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%node_elem_idx))-1 ) = PACK(InData%node_elem_idx,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%node_elem_idx) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%refine - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%dof_node - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%dof_elem - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%rot_elem - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%elem_total - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%node_total - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%dof_total - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%nqp - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%analysis_type - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%damp_flag - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%ld_retries - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%niter - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%quadrature - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%n_fact - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%OutInputs , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(InData%node_elem_idx,2), UBOUND(InData%node_elem_idx,2) + DO i1 = LBOUND(InData%node_elem_idx,1), UBOUND(InData%node_elem_idx,1) + IntKiBuf(Int_Xferred) = InData%node_elem_idx(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + IntKiBuf(Int_Xferred) = InData%refine + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%dof_node + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%dof_elem + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%rot_elem + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%elem_total + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%node_total + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%dof_total + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nqp + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%analysis_type + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%damp_flag + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%ld_retries + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%niter + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%quadrature + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%n_fact + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%OutInputs, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%OutParam) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4697,10 +4894,12 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si ENDIF END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NNodeOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%OutNd))-1 ) = PACK(InData%OutNd,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%OutNd) + IntKiBuf(Int_Xferred) = InData%NNodeOuts + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%OutNd,1), UBOUND(InData%OutNd,1) + IntKiBuf(Int_Xferred) = InData%OutNd(i1) + Int_Xferred = Int_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%NdIndx) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4711,8 +4910,25 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NdIndx,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%NdIndx)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%NdIndx))-1 ) = PACK(InData%NdIndx,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%NdIndx) + DO i1 = LBOUND(InData%NdIndx,1), UBOUND(InData%NdIndx,1) + IntKiBuf(Int_Xferred) = InData%NdIndx(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%NdIndxInverse) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%NdIndxInverse,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NdIndxInverse,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%NdIndxInverse,1), UBOUND(InData%NdIndxInverse,1) + IntKiBuf(Int_Xferred) = InData%NdIndxInverse(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%OutNd2NdElem) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4727,23 +4943,31 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutNd2NdElem,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%OutNd2NdElem)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%OutNd2NdElem))-1 ) = PACK(InData%OutNd2NdElem,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%OutNd2NdElem) + DO i2 = LBOUND(InData%OutNd2NdElem,2), UBOUND(InData%OutNd2NdElem,2) + DO i1 = LBOUND(InData%OutNd2NdElem,1), UBOUND(InData%OutNd2NdElem,1) + IntKiBuf(Int_Xferred) = InData%OutNd2NdElem(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF - DO I = 1, LEN(InData%OutFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%UsePitchAct , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%pitchJ - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%pitchK - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%pitchC - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%torqM))-1 ) = PACK(InData%torqM,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%torqM) + DO I = 1, LEN(InData%OutFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%UsePitchAct, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%pitchJ + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%pitchK + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%pitchC + Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(InData%torqM,2), UBOUND(InData%torqM,2) + DO i1 = LBOUND(InData%torqM,1), UBOUND(InData%torqM,1) + ReKiBuf(Re_Xferred) = InData%torqM(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO CALL BD_Packqpparam( Re_Buf, Db_Buf, Int_Buf, InData%qp, ErrStat2, ErrMsg2, OnlySize ) ! qp CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4772,18 +4996,78 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%qp_indx_offset - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%BldMotionNodeLoc - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%tngt_stf_fd , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%tngt_stf_comp , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%tngt_stf_pert - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%tngt_stf_difftol - Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%qp_indx_offset + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%BldMotionNodeLoc + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%tngt_stf_fd, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%tngt_stf_comp, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%tngt_stf_pert + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%tngt_stf_difftol + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%BldNd_NumOuts + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%BldNd_TotNumOuts + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%BldNd_OutParam) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BldNd_OutParam,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldNd_OutParam,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%BldNd_OutParam,1), UBOUND(InData%BldNd_OutParam,1) + CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%BldNd_OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! BldNd_OutParam + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%BldNd_BlOutNd) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BldNd_BlOutNd,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldNd_BlOutNd,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%BldNd_BlOutNd,1), UBOUND(InData%BldNd_BlOutNd,1) + IntKiBuf(Int_Xferred) = InData%BldNd_BlOutNd(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF IF ( .NOT. ALLOCATED(InData%QPtw_Shp_Shp_Jac) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4803,8 +5087,16 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtw_Shp_Shp_Jac,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%QPtw_Shp_Shp_Jac)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%QPtw_Shp_Shp_Jac))-1 ) = PACK(InData%QPtw_Shp_Shp_Jac,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%QPtw_Shp_Shp_Jac) + DO i4 = LBOUND(InData%QPtw_Shp_Shp_Jac,4), UBOUND(InData%QPtw_Shp_Shp_Jac,4) + DO i3 = LBOUND(InData%QPtw_Shp_Shp_Jac,3), UBOUND(InData%QPtw_Shp_Shp_Jac,3) + DO i2 = LBOUND(InData%QPtw_Shp_Shp_Jac,2), UBOUND(InData%QPtw_Shp_Shp_Jac,2) + DO i1 = LBOUND(InData%QPtw_Shp_Shp_Jac,1), UBOUND(InData%QPtw_Shp_Shp_Jac,1) + DbKiBuf(Db_Xferred) = InData%QPtw_Shp_Shp_Jac(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%QPtw_Shp_ShpDer) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4822,8 +5114,14 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtw_Shp_ShpDer,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%QPtw_Shp_ShpDer)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%QPtw_Shp_ShpDer))-1 ) = PACK(InData%QPtw_Shp_ShpDer,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%QPtw_Shp_ShpDer) + DO i3 = LBOUND(InData%QPtw_Shp_ShpDer,3), UBOUND(InData%QPtw_Shp_ShpDer,3) + DO i2 = LBOUND(InData%QPtw_Shp_ShpDer,2), UBOUND(InData%QPtw_Shp_ShpDer,2) + DO i1 = LBOUND(InData%QPtw_Shp_ShpDer,1), UBOUND(InData%QPtw_Shp_ShpDer,1) + DbKiBuf(Db_Xferred) = InData%QPtw_Shp_ShpDer(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%QPtw_ShpDer_ShpDer_Jac) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4844,8 +5142,16 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtw_ShpDer_ShpDer_Jac,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%QPtw_ShpDer_ShpDer_Jac)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%QPtw_ShpDer_ShpDer_Jac))-1 ) = PACK(InData%QPtw_ShpDer_ShpDer_Jac,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%QPtw_ShpDer_ShpDer_Jac) + DO i4 = LBOUND(InData%QPtw_ShpDer_ShpDer_Jac,4), UBOUND(InData%QPtw_ShpDer_ShpDer_Jac,4) + DO i3 = LBOUND(InData%QPtw_ShpDer_ShpDer_Jac,3), UBOUND(InData%QPtw_ShpDer_ShpDer_Jac,3) + DO i2 = LBOUND(InData%QPtw_ShpDer_ShpDer_Jac,2), UBOUND(InData%QPtw_ShpDer_ShpDer_Jac,2) + DO i1 = LBOUND(InData%QPtw_ShpDer_ShpDer_Jac,1), UBOUND(InData%QPtw_ShpDer_ShpDer_Jac,1) + DbKiBuf(Db_Xferred) = InData%QPtw_ShpDer_ShpDer_Jac(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%QPtw_Shp_Jac) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4863,8 +5169,14 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtw_Shp_Jac,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%QPtw_Shp_Jac)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%QPtw_Shp_Jac))-1 ) = PACK(InData%QPtw_Shp_Jac,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%QPtw_Shp_Jac) + DO i3 = LBOUND(InData%QPtw_Shp_Jac,3), UBOUND(InData%QPtw_Shp_Jac,3) + DO i2 = LBOUND(InData%QPtw_Shp_Jac,2), UBOUND(InData%QPtw_Shp_Jac,2) + DO i1 = LBOUND(InData%QPtw_Shp_Jac,1), UBOUND(InData%QPtw_Shp_Jac,1) + DbKiBuf(Db_Xferred) = InData%QPtw_Shp_Jac(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%QPtw_ShpDer) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4879,8 +5191,12 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QPtw_ShpDer,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%QPtw_ShpDer)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%QPtw_ShpDer))-1 ) = PACK(InData%QPtw_ShpDer,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%QPtw_ShpDer) + DO i2 = LBOUND(InData%QPtw_ShpDer,2), UBOUND(InData%QPtw_ShpDer,2) + DO i1 = LBOUND(InData%QPtw_ShpDer,1), UBOUND(InData%QPtw_ShpDer,1) + DbKiBuf(Db_Xferred) = InData%QPtw_ShpDer(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%FEweight) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4895,8 +5211,12 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FEweight,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FEweight)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%FEweight))-1 ) = PACK(InData%FEweight,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%FEweight) + DO i2 = LBOUND(InData%FEweight,2), UBOUND(InData%FEweight,2) + DO i1 = LBOUND(InData%FEweight,1), UBOUND(InData%FEweight,1) + DbKiBuf(Db_Xferred) = InData%FEweight(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Jac_u_indx) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4911,8 +5231,12 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Jac_u_indx)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%Jac_u_indx))-1 ) = PACK(InData%Jac_u_indx,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%Jac_u_indx) + DO i2 = LBOUND(InData%Jac_u_indx,2), UBOUND(InData%Jac_u_indx,2) + DO i1 = LBOUND(InData%Jac_u_indx,1), UBOUND(InData%Jac_u_indx,1) + IntKiBuf(Int_Xferred) = InData%Jac_u_indx(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%du) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4924,19 +5248,23 @@ SUBROUTINE BD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%du,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%du)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%du))-1 ) = PACK(InData%du,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%du) + DO i1 = LBOUND(InData%du,1), UBOUND(InData%du,1) + DbKiBuf(Db_Xferred) = InData%du(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%dx))-1 ) = PACK(InData%dx,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%dx) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Jac_ny - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Jac_nx - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%RotStates , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%RelStates , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%dx,1), UBOUND(InData%dx,1) + DbKiBuf(Db_Xferred) = InData%dx(i1) + Db_Xferred = Db_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%Jac_ny + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Jac_nx + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%RotStates, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%RelStates, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE BD_PackParam SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -4952,12 +5280,6 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (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 @@ -4975,21 +5297,16 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%dt = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%dt = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 i1_l = LBOUND(OutData%coef,1) i1_u = UBOUND(OutData%coef,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%coef = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%coef))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%coef) - DEALLOCATE(mask1) - OutData%rhoinf = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(OutData%coef,1), UBOUND(OutData%coef,1) + OutData%coef(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + OutData%rhoinf = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! uuN0 not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5009,15 +5326,14 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%uuN0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%uuN0)>0) OutData%uuN0 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%uuN0))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%uuN0) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%uuN0,3), UBOUND(OutData%uuN0,3) + DO i2 = LBOUND(OutData%uuN0,2), UBOUND(OutData%uuN0,2) + DO i1 = LBOUND(OutData%uuN0,1), UBOUND(OutData%uuN0,1) + OutData%uuN0(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Stif0_QP not allocated Int_Xferred = Int_Xferred + 1 @@ -5038,15 +5354,14 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Stif0_QP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%Stif0_QP)>0) OutData%Stif0_QP = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Stif0_QP))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Stif0_QP) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%Stif0_QP,3), UBOUND(OutData%Stif0_QP,3) + DO i2 = LBOUND(OutData%Stif0_QP,2), UBOUND(OutData%Stif0_QP,2) + DO i1 = LBOUND(OutData%Stif0_QP,1), UBOUND(OutData%Stif0_QP,1) + OutData%Stif0_QP(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Mass0_QP not allocated Int_Xferred = Int_Xferred + 1 @@ -5067,27 +5382,21 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mass0_QP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%Mass0_QP)>0) OutData%Mass0_QP = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Mass0_QP))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Mass0_QP) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%Mass0_QP,3), UBOUND(OutData%Mass0_QP,3) + DO i2 = LBOUND(OutData%Mass0_QP,2), UBOUND(OutData%Mass0_QP,2) + DO i1 = LBOUND(OutData%Mass0_QP,1), UBOUND(OutData%Mass0_QP,1) + OutData%Mass0_QP(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF i1_l = LBOUND(OutData%gravity,1) i1_u = UBOUND(OutData%gravity,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%gravity = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%gravity))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%gravity) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%gravity,1), UBOUND(OutData%gravity,1) + OutData%gravity(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! segment_eta not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5101,15 +5410,10 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%segment_eta.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%segment_eta)>0) OutData%segment_eta = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%segment_eta))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%segment_eta) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%segment_eta,1), UBOUND(OutData%segment_eta,1) + OutData%segment_eta(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! member_eta not allocated Int_Xferred = Int_Xferred + 1 @@ -5124,92 +5428,61 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%member_eta.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%member_eta)>0) OutData%member_eta = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%member_eta))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%member_eta) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%member_eta,1), UBOUND(OutData%member_eta,1) + OutData%member_eta(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO END IF - OutData%blade_length = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%blade_mass = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 + OutData%blade_length = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%blade_mass = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 i1_l = LBOUND(OutData%blade_CG,1) i1_u = UBOUND(OutData%blade_CG,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%blade_CG = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%blade_CG))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%blade_CG) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%blade_CG,1), UBOUND(OutData%blade_CG,1) + OutData%blade_CG(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%blade_IN,1) i1_u = UBOUND(OutData%blade_IN,1) i2_l = LBOUND(OutData%blade_IN,2) i2_u = UBOUND(OutData%blade_IN,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%blade_IN = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%blade_IN))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%blade_IN) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%blade_IN,2), UBOUND(OutData%blade_IN,2) + DO i1 = LBOUND(OutData%blade_IN,1), UBOUND(OutData%blade_IN,1) + OutData%blade_IN(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%beta,1) i1_u = UBOUND(OutData%beta,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%beta = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%beta))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%beta) - DEALLOCATE(mask1) - OutData%tol = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(OutData%beta,1), UBOUND(OutData%beta,1) + OutData%beta(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + OutData%tol = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 i1_l = LBOUND(OutData%GlbPos,1) i1_u = UBOUND(OutData%GlbPos,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%GlbPos = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%GlbPos))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%GlbPos) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%GlbPos,1), UBOUND(OutData%GlbPos,1) + OutData%GlbPos(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%GlbRot,1) i1_u = UBOUND(OutData%GlbRot,1) i2_l = LBOUND(OutData%GlbRot,2) i2_u = UBOUND(OutData%GlbRot,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%GlbRot = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%GlbRot))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%GlbRot) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%GlbRot,2), UBOUND(OutData%GlbRot,2) + DO i1 = LBOUND(OutData%GlbRot,1), UBOUND(OutData%GlbRot,1) + OutData%GlbRot(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%Glb_crv,1) i1_u = UBOUND(OutData%Glb_crv,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%Glb_crv = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Glb_crv))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Glb_crv) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Glb_crv,1), UBOUND(OutData%Glb_crv,1) + OutData%Glb_crv(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QPtN not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5223,15 +5496,10 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%QPtN.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%QPtN)>0) OutData%QPtN = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%QPtN))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%QPtN) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%QPtN,1), UBOUND(OutData%QPtN,1) + OutData%QPtN(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QPtWeight not allocated Int_Xferred = Int_Xferred + 1 @@ -5246,15 +5514,10 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%QPtWeight.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%QPtWeight)>0) OutData%QPtWeight = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%QPtWeight))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%QPtWeight) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%QPtWeight,1), UBOUND(OutData%QPtWeight,1) + OutData%QPtWeight(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Shp not allocated Int_Xferred = Int_Xferred + 1 @@ -5272,15 +5535,12 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Shp.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Shp)>0) OutData%Shp = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Shp))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Shp) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Shp,2), UBOUND(OutData%Shp,2) + DO i1 = LBOUND(OutData%Shp,1), UBOUND(OutData%Shp,1) + OutData%Shp(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ShpDer not allocated Int_Xferred = Int_Xferred + 1 @@ -5298,15 +5558,12 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ShpDer.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%ShpDer)>0) OutData%ShpDer = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%ShpDer))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%ShpDer) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%ShpDer,2), UBOUND(OutData%ShpDer,2) + DO i1 = LBOUND(OutData%ShpDer,1), UBOUND(OutData%ShpDer,1) + OutData%ShpDer(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jacobian not allocated Int_Xferred = Int_Xferred + 1 @@ -5324,15 +5581,12 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jacobian.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Jacobian)>0) OutData%Jacobian = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Jacobian))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Jacobian) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Jacobian,2), UBOUND(OutData%Jacobian,2) + DO i1 = LBOUND(OutData%Jacobian,1), UBOUND(OutData%Jacobian,1) + OutData%Jacobian(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! uu0 not allocated Int_Xferred = Int_Xferred + 1 @@ -5353,15 +5607,14 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%uu0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%uu0)>0) OutData%uu0 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%uu0))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%uu0) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%uu0,3), UBOUND(OutData%uu0,3) + DO i2 = LBOUND(OutData%uu0,2), UBOUND(OutData%uu0,2) + DO i1 = LBOUND(OutData%uu0,1), UBOUND(OutData%uu0,1) + OutData%uu0(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rrN0 not allocated Int_Xferred = Int_Xferred + 1 @@ -5382,15 +5635,14 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rrN0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%rrN0)>0) OutData%rrN0 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rrN0))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rrN0) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%rrN0,3), UBOUND(OutData%rrN0,3) + DO i2 = LBOUND(OutData%rrN0,2), UBOUND(OutData%rrN0,2) + DO i1 = LBOUND(OutData%rrN0,1), UBOUND(OutData%rrN0,1) + OutData%rrN0(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! E10 not allocated Int_Xferred = Int_Xferred + 1 @@ -5411,15 +5663,14 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%E10.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%E10)>0) OutData%E10 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%E10))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%E10) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%E10,3), UBOUND(OutData%E10,3) + DO i2 = LBOUND(OutData%E10,2), UBOUND(OutData%E10,2) + DO i1 = LBOUND(OutData%E10,1), UBOUND(OutData%E10,1) + OutData%E10(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SP_Coef not allocated Int_Xferred = Int_Xferred + 1 @@ -5440,18 +5691,17 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SP_Coef.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%SP_Coef)>0) OutData%SP_Coef = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%SP_Coef))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%SP_Coef) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%SP_Coef,3), UBOUND(OutData%SP_Coef,3) + DO i2 = LBOUND(OutData%SP_Coef,2), UBOUND(OutData%SP_Coef,2) + DO i1 = LBOUND(OutData%SP_Coef,1), UBOUND(OutData%SP_Coef,1) + OutData%SP_Coef(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF - OutData%nodes_per_elem = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%nodes_per_elem = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! node_elem_idx not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5468,48 +5718,45 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%node_elem_idx.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%node_elem_idx)>0) OutData%node_elem_idx = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%node_elem_idx))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%node_elem_idx) - DEALLOCATE(mask2) - END IF - OutData%refine = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%dof_node = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%dof_elem = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%rot_elem = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%elem_total = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%node_total = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%dof_total = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%nqp = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%analysis_type = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%damp_flag = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%ld_retries = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%niter = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%quadrature = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%n_fact = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%OutInputs = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(OutData%node_elem_idx,2), UBOUND(OutData%node_elem_idx,2) + DO i1 = LBOUND(OutData%node_elem_idx,1), UBOUND(OutData%node_elem_idx,1) + OutData%node_elem_idx(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + OutData%refine = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%dof_node = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%dof_elem = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%rot_elem = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%elem_total = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%node_total = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%dof_total = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nqp = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%analysis_type = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%damp_flag = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ld_retries = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%niter = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%quadrature = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%n_fact = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%OutInputs = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutInputs) + Int_Xferred = Int_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParam not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5566,19 +5813,14 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%NNodeOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NNodeOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%OutNd,1) i1_u = UBOUND(OutData%OutNd,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%OutNd = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%OutNd))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%OutNd) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%OutNd,1), UBOUND(OutData%OutNd,1) + OutData%OutNd(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NdIndx not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5592,15 +5834,28 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NdIndx.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) + DO i1 = LBOUND(OutData%NdIndx,1), UBOUND(OutData%NdIndx,1) + OutData%NdIndx(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NdIndxInverse not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%NdIndxInverse)) DEALLOCATE(OutData%NdIndxInverse) + ALLOCATE(OutData%NdIndxInverse(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NdIndxInverse.', ErrStat, ErrMsg,RoutineName) RETURN END IF - mask1 = .TRUE. - IF (SIZE(OutData%NdIndx)>0) OutData%NdIndx = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%NdIndx))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%NdIndx) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%NdIndxInverse,1), UBOUND(OutData%NdIndxInverse,1) + OutData%NdIndxInverse(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutNd2NdElem not allocated Int_Xferred = Int_Xferred + 1 @@ -5609,50 +5864,114 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OutNd2NdElem)) DEALLOCATE(OutData%OutNd2NdElem) - ALLOCATE(OutData%OutNd2NdElem(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutNd2NdElem.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%OutNd2NdElem)>0) OutData%OutNd2NdElem = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%OutNd2NdElem))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%OutNd2NdElem) - DEALLOCATE(mask2) - END IF - DO I = 1, LEN(OutData%OutFmt) - OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%UsePitchAct = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%pitchJ = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%pitchK = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%pitchC = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%torqM,1) - i1_u = UBOUND(OutData%torqM,1) - i2_l = LBOUND(OutData%torqM,2) - i2_u = UBOUND(OutData%torqM,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%OutNd2NdElem)) DEALLOCATE(OutData%OutNd2NdElem) + ALLOCATE(OutData%OutNd2NdElem(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutNd2NdElem.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%OutNd2NdElem,2), UBOUND(OutData%OutNd2NdElem,2) + DO i1 = LBOUND(OutData%OutNd2NdElem,1), UBOUND(OutData%OutNd2NdElem,1) + OutData%OutNd2NdElem(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + DO I = 1, LEN(OutData%OutFmt) + OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%UsePitchAct = TRANSFER(IntKiBuf(Int_Xferred), OutData%UsePitchAct) + Int_Xferred = Int_Xferred + 1 + OutData%pitchJ = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%pitchK = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%pitchC = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + i1_l = LBOUND(OutData%torqM,1) + i1_u = UBOUND(OutData%torqM,1) + i2_l = LBOUND(OutData%torqM,2) + i2_u = UBOUND(OutData%torqM,2) + DO i2 = LBOUND(OutData%torqM,2), UBOUND(OutData%torqM,2) + DO i1 = LBOUND(OutData%torqM,1), UBOUND(OutData%torqM,1) + OutData%torqM(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL BD_Unpackqpparam( Re_Buf, Db_Buf, Int_Buf, OutData%qp, ErrStat2, ErrMsg2 ) ! qp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + OutData%qp_indx_offset = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%BldMotionNodeLoc = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%tngt_stf_fd = TRANSFER(IntKiBuf(Int_Xferred), OutData%tngt_stf_fd) + Int_Xferred = Int_Xferred + 1 + OutData%tngt_stf_comp = TRANSFER(IntKiBuf(Int_Xferred), OutData%tngt_stf_comp) + Int_Xferred = Int_Xferred + 1 + OutData%tngt_stf_pert = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%tngt_stf_difftol = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%BldNd_NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%BldNd_TotNumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldNd_OutParam not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BldNd_OutParam)) DEALLOCATE(OutData%BldNd_OutParam) + ALLOCATE(OutData%BldNd_OutParam(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_OutParam.', ErrStat, ErrMsg,RoutineName) RETURN END IF - mask2 = .TRUE. - OutData%torqM = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%torqM))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%torqM) - DEALLOCATE(mask2) + DO i1 = LBOUND(OutData%BldNd_OutParam,1), UBOUND(OutData%BldNd_OutParam,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -5686,25 +6005,33 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL BD_Unpackqpparam( Re_Buf, Db_Buf, Int_Buf, OutData%qp, ErrStat2, ErrMsg2 ) ! qp + CALL NWTC_Library_Unpackoutparmtype( Re_Buf, Db_Buf, Int_Buf, OutData%BldNd_OutParam(i1), ErrStat2, ErrMsg2 ) ! BldNd_OutParam CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%qp_indx_offset = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%BldMotionNodeLoc = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%tngt_stf_fd = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%tngt_stf_comp = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%tngt_stf_pert = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%tngt_stf_difftol = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldNd_BlOutNd not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BldNd_BlOutNd)) DEALLOCATE(OutData%BldNd_BlOutNd) + ALLOCATE(OutData%BldNd_BlOutNd(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_BlOutNd.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%BldNd_BlOutNd,1), UBOUND(OutData%BldNd_BlOutNd,1) + OutData%BldNd_BlOutNd(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QPtw_Shp_Shp_Jac not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5727,15 +6054,16 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%QPtw_Shp_Shp_Jac.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%QPtw_Shp_Shp_Jac)>0) OutData%QPtw_Shp_Shp_Jac = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%QPtw_Shp_Shp_Jac))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%QPtw_Shp_Shp_Jac) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%QPtw_Shp_Shp_Jac,4), UBOUND(OutData%QPtw_Shp_Shp_Jac,4) + DO i3 = LBOUND(OutData%QPtw_Shp_Shp_Jac,3), UBOUND(OutData%QPtw_Shp_Shp_Jac,3) + DO i2 = LBOUND(OutData%QPtw_Shp_Shp_Jac,2), UBOUND(OutData%QPtw_Shp_Shp_Jac,2) + DO i1 = LBOUND(OutData%QPtw_Shp_Shp_Jac,1), UBOUND(OutData%QPtw_Shp_Shp_Jac,1) + OutData%QPtw_Shp_Shp_Jac(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QPtw_Shp_ShpDer not allocated Int_Xferred = Int_Xferred + 1 @@ -5756,15 +6084,14 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%QPtw_Shp_ShpDer.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%QPtw_Shp_ShpDer)>0) OutData%QPtw_Shp_ShpDer = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%QPtw_Shp_ShpDer))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%QPtw_Shp_ShpDer) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%QPtw_Shp_ShpDer,3), UBOUND(OutData%QPtw_Shp_ShpDer,3) + DO i2 = LBOUND(OutData%QPtw_Shp_ShpDer,2), UBOUND(OutData%QPtw_Shp_ShpDer,2) + DO i1 = LBOUND(OutData%QPtw_Shp_ShpDer,1), UBOUND(OutData%QPtw_Shp_ShpDer,1) + OutData%QPtw_Shp_ShpDer(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QPtw_ShpDer_ShpDer_Jac not allocated Int_Xferred = Int_Xferred + 1 @@ -5788,15 +6115,16 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%QPtw_ShpDer_ShpDer_Jac.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%QPtw_ShpDer_ShpDer_Jac)>0) OutData%QPtw_ShpDer_ShpDer_Jac = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%QPtw_ShpDer_ShpDer_Jac))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%QPtw_ShpDer_ShpDer_Jac) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%QPtw_ShpDer_ShpDer_Jac,4), UBOUND(OutData%QPtw_ShpDer_ShpDer_Jac,4) + DO i3 = LBOUND(OutData%QPtw_ShpDer_ShpDer_Jac,3), UBOUND(OutData%QPtw_ShpDer_ShpDer_Jac,3) + DO i2 = LBOUND(OutData%QPtw_ShpDer_ShpDer_Jac,2), UBOUND(OutData%QPtw_ShpDer_ShpDer_Jac,2) + DO i1 = LBOUND(OutData%QPtw_ShpDer_ShpDer_Jac,1), UBOUND(OutData%QPtw_ShpDer_ShpDer_Jac,1) + OutData%QPtw_ShpDer_ShpDer_Jac(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QPtw_Shp_Jac not allocated Int_Xferred = Int_Xferred + 1 @@ -5817,15 +6145,14 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%QPtw_Shp_Jac.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%QPtw_Shp_Jac)>0) OutData%QPtw_Shp_Jac = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%QPtw_Shp_Jac))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%QPtw_Shp_Jac) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%QPtw_Shp_Jac,3), UBOUND(OutData%QPtw_Shp_Jac,3) + DO i2 = LBOUND(OutData%QPtw_Shp_Jac,2), UBOUND(OutData%QPtw_Shp_Jac,2) + DO i1 = LBOUND(OutData%QPtw_Shp_Jac,1), UBOUND(OutData%QPtw_Shp_Jac,1) + OutData%QPtw_Shp_Jac(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QPtw_ShpDer not allocated Int_Xferred = Int_Xferred + 1 @@ -5843,15 +6170,12 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%QPtw_ShpDer.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%QPtw_ShpDer)>0) OutData%QPtw_ShpDer = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%QPtw_ShpDer))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%QPtw_ShpDer) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%QPtw_ShpDer,2), UBOUND(OutData%QPtw_ShpDer,2) + DO i1 = LBOUND(OutData%QPtw_ShpDer,1), UBOUND(OutData%QPtw_ShpDer,1) + OutData%QPtw_ShpDer(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FEweight not allocated Int_Xferred = Int_Xferred + 1 @@ -5869,15 +6193,12 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FEweight.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%FEweight)>0) OutData%FEweight = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%FEweight))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%FEweight) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%FEweight,2), UBOUND(OutData%FEweight,2) + DO i1 = LBOUND(OutData%FEweight,1), UBOUND(OutData%FEweight,1) + OutData%FEweight(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_u_indx not allocated Int_Xferred = Int_Xferred + 1 @@ -5895,15 +6216,12 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Jac_u_indx)>0) OutData%Jac_u_indx = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%Jac_u_indx))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%Jac_u_indx) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Jac_u_indx,2), UBOUND(OutData%Jac_u_indx,2) + DO i1 = LBOUND(OutData%Jac_u_indx,1), UBOUND(OutData%Jac_u_indx,1) + OutData%Jac_u_indx(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! du not allocated Int_Xferred = Int_Xferred + 1 @@ -5918,35 +6236,25 @@ SUBROUTINE BD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%du.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%du)>0) OutData%du = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%du))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%du) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%du,1), UBOUND(OutData%du,1) + OutData%du(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO END IF i1_l = LBOUND(OutData%dx,1) i1_u = UBOUND(OutData%dx,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%dx = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%dx))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%dx) - DEALLOCATE(mask1) - OutData%Jac_ny = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%Jac_nx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%RotStates = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%RelStates = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%dx,1), UBOUND(OutData%dx,1) + OutData%dx(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + OutData%Jac_ny = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%Jac_nx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%RotStates = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotStates) + Int_Xferred = Int_Xferred + 1 + OutData%RelStates = TRANSFER(IntKiBuf(Int_Xferred), OutData%RelStates) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE BD_UnPackParam SUBROUTINE BD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -6250,12 +6558,6 @@ SUBROUTINE BD_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'BD_UnPackInput' @@ -6644,10 +6946,10 @@ SUBROUTINE BD_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RootMxr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RootMyr - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RootMxr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RootMyr + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WriteOutput) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -6658,8 +6960,10 @@ SUBROUTINE BD_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WriteOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WriteOutput))-1 ) = PACK(InData%WriteOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WriteOutput) + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE BD_PackOutput @@ -6676,12 +6980,6 @@ SUBROUTINE BD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -6776,10 +7074,10 @@ SUBROUTINE BD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%RootMxr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RootMyr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%RootMxr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RootMyr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutput not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -6793,15 +7091,10 @@ SUBROUTINE BD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WriteOutput)>0) OutData%WriteOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WriteOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WriteOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE BD_UnPackOutput @@ -7692,8 +7985,14 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uuu,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%uuu)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%uuu))-1 ) = PACK(InData%uuu,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%uuu) + DO i3 = LBOUND(InData%uuu,3), UBOUND(InData%uuu,3) + DO i2 = LBOUND(InData%uuu,2), UBOUND(InData%uuu,2) + DO i1 = LBOUND(InData%uuu,1), UBOUND(InData%uuu,1) + DbKiBuf(Db_Xferred) = InData%uuu(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%uup) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7711,8 +8010,14 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%uup,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%uup)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%uup))-1 ) = PACK(InData%uup,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%uup) + DO i3 = LBOUND(InData%uup,3), UBOUND(InData%uup,3) + DO i2 = LBOUND(InData%uup,2), UBOUND(InData%uup,2) + DO i1 = LBOUND(InData%uup,1), UBOUND(InData%uup,1) + DbKiBuf(Db_Xferred) = InData%uup(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%vvv) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7730,8 +8035,14 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vvv,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%vvv)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%vvv))-1 ) = PACK(InData%vvv,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%vvv) + DO i3 = LBOUND(InData%vvv,3), UBOUND(InData%vvv,3) + DO i2 = LBOUND(InData%vvv,2), UBOUND(InData%vvv,2) + DO i1 = LBOUND(InData%vvv,1), UBOUND(InData%vvv,1) + DbKiBuf(Db_Xferred) = InData%vvv(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%vvp) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7749,8 +8060,14 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%vvp,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%vvp)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%vvp))-1 ) = PACK(InData%vvp,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%vvp) + DO i3 = LBOUND(InData%vvp,3), UBOUND(InData%vvp,3) + DO i2 = LBOUND(InData%vvp,2), UBOUND(InData%vvp,2) + DO i1 = LBOUND(InData%vvp,1), UBOUND(InData%vvp,1) + DbKiBuf(Db_Xferred) = InData%vvp(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%aaa) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7768,8 +8085,14 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%aaa,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%aaa)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%aaa))-1 ) = PACK(InData%aaa,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%aaa) + DO i3 = LBOUND(InData%aaa,3), UBOUND(InData%aaa,3) + DO i2 = LBOUND(InData%aaa,2), UBOUND(InData%aaa,2) + DO i1 = LBOUND(InData%aaa,1), UBOUND(InData%aaa,1) + DbKiBuf(Db_Xferred) = InData%aaa(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%RR0) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7790,8 +8113,16 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RR0,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RR0)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%RR0))-1 ) = PACK(InData%RR0,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%RR0) + DO i4 = LBOUND(InData%RR0,4), UBOUND(InData%RR0,4) + DO i3 = LBOUND(InData%RR0,3), UBOUND(InData%RR0,3) + DO i2 = LBOUND(InData%RR0,2), UBOUND(InData%RR0,2) + DO i1 = LBOUND(InData%RR0,1), UBOUND(InData%RR0,1) + DbKiBuf(Db_Xferred) = InData%RR0(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%kappa) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7809,8 +8140,14 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%kappa,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%kappa)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%kappa))-1 ) = PACK(InData%kappa,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%kappa) + DO i3 = LBOUND(InData%kappa,3), UBOUND(InData%kappa,3) + DO i2 = LBOUND(InData%kappa,2), UBOUND(InData%kappa,2) + DO i1 = LBOUND(InData%kappa,1), UBOUND(InData%kappa,1) + DbKiBuf(Db_Xferred) = InData%kappa(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%E1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7828,8 +8165,14 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%E1,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%E1)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%E1))-1 ) = PACK(InData%E1,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%E1) + DO i3 = LBOUND(InData%E1,3), UBOUND(InData%E1,3) + DO i2 = LBOUND(InData%E1,2), UBOUND(InData%E1,2) + DO i1 = LBOUND(InData%E1,1), UBOUND(InData%E1,1) + DbKiBuf(Db_Xferred) = InData%E1(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Stif) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7850,8 +8193,16 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Stif,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Stif)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Stif))-1 ) = PACK(InData%Stif,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Stif) + DO i4 = LBOUND(InData%Stif,4), UBOUND(InData%Stif,4) + DO i3 = LBOUND(InData%Stif,3), UBOUND(InData%Stif,3) + DO i2 = LBOUND(InData%Stif,2), UBOUND(InData%Stif,2) + DO i1 = LBOUND(InData%Stif,1), UBOUND(InData%Stif,1) + DbKiBuf(Db_Xferred) = InData%Stif(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Fb) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7869,8 +8220,14 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fb,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Fb)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Fb))-1 ) = PACK(InData%Fb,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Fb) + DO i3 = LBOUND(InData%Fb,3), UBOUND(InData%Fb,3) + DO i2 = LBOUND(InData%Fb,2), UBOUND(InData%Fb,2) + DO i1 = LBOUND(InData%Fb,1), UBOUND(InData%Fb,1) + DbKiBuf(Db_Xferred) = InData%Fb(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Fc) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7888,8 +8245,14 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fc,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Fc)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Fc))-1 ) = PACK(InData%Fc,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Fc) + DO i3 = LBOUND(InData%Fc,3), UBOUND(InData%Fc,3) + DO i2 = LBOUND(InData%Fc,2), UBOUND(InData%Fc,2) + DO i1 = LBOUND(InData%Fc,1), UBOUND(InData%Fc,1) + DbKiBuf(Db_Xferred) = InData%Fc(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Fd) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7907,8 +8270,14 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fd,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Fd)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Fd))-1 ) = PACK(InData%Fd,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Fd) + DO i3 = LBOUND(InData%Fd,3), UBOUND(InData%Fd,3) + DO i2 = LBOUND(InData%Fd,2), UBOUND(InData%Fd,2) + DO i1 = LBOUND(InData%Fd,1), UBOUND(InData%Fd,1) + DbKiBuf(Db_Xferred) = InData%Fd(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Fg) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7926,8 +8295,14 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fg,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Fg)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Fg))-1 ) = PACK(InData%Fg,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Fg) + DO i3 = LBOUND(InData%Fg,3), UBOUND(InData%Fg,3) + DO i2 = LBOUND(InData%Fg,2), UBOUND(InData%Fg,2) + DO i1 = LBOUND(InData%Fg,1), UBOUND(InData%Fg,1) + DbKiBuf(Db_Xferred) = InData%Fg(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Fi) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7945,8 +8320,14 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fi,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Fi)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Fi))-1 ) = PACK(InData%Fi,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Fi) + DO i3 = LBOUND(InData%Fi,3), UBOUND(InData%Fi,3) + DO i2 = LBOUND(InData%Fi,2), UBOUND(InData%Fi,2) + DO i1 = LBOUND(InData%Fi,1), UBOUND(InData%Fi,1) + DbKiBuf(Db_Xferred) = InData%Fi(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Ftemp) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7964,8 +8345,14 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ftemp,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Ftemp)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Ftemp))-1 ) = PACK(InData%Ftemp,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Ftemp) + DO i3 = LBOUND(InData%Ftemp,3), UBOUND(InData%Ftemp,3) + DO i2 = LBOUND(InData%Ftemp,2), UBOUND(InData%Ftemp,2) + DO i1 = LBOUND(InData%Ftemp,1), UBOUND(InData%Ftemp,1) + DbKiBuf(Db_Xferred) = InData%Ftemp(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%RR0mEta) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7983,8 +8370,14 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RR0mEta,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RR0mEta)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%RR0mEta))-1 ) = PACK(InData%RR0mEta,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%RR0mEta) + DO i3 = LBOUND(InData%RR0mEta,3), UBOUND(InData%RR0mEta,3) + DO i2 = LBOUND(InData%RR0mEta,2), UBOUND(InData%RR0mEta,2) + DO i1 = LBOUND(InData%RR0mEta,1), UBOUND(InData%RR0mEta,1) + DbKiBuf(Db_Xferred) = InData%RR0mEta(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%rho) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8005,8 +8398,16 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rho,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%rho)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rho))-1 ) = PACK(InData%rho,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rho) + DO i4 = LBOUND(InData%rho,4), UBOUND(InData%rho,4) + DO i3 = LBOUND(InData%rho,3), UBOUND(InData%rho,3) + DO i2 = LBOUND(InData%rho,2), UBOUND(InData%rho,2) + DO i1 = LBOUND(InData%rho,1), UBOUND(InData%rho,1) + DbKiBuf(Db_Xferred) = InData%rho(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%betaC) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8027,8 +8428,16 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%betaC,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%betaC)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%betaC))-1 ) = PACK(InData%betaC,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%betaC) + DO i4 = LBOUND(InData%betaC,4), UBOUND(InData%betaC,4) + DO i3 = LBOUND(InData%betaC,3), UBOUND(InData%betaC,3) + DO i2 = LBOUND(InData%betaC,2), UBOUND(InData%betaC,2) + DO i1 = LBOUND(InData%betaC,1), UBOUND(InData%betaC,1) + DbKiBuf(Db_Xferred) = InData%betaC(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Gi) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8049,8 +8458,16 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gi,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Gi)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Gi))-1 ) = PACK(InData%Gi,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Gi) + DO i4 = LBOUND(InData%Gi,4), UBOUND(InData%Gi,4) + DO i3 = LBOUND(InData%Gi,3), UBOUND(InData%Gi,3) + DO i2 = LBOUND(InData%Gi,2), UBOUND(InData%Gi,2) + DO i1 = LBOUND(InData%Gi,1), UBOUND(InData%Gi,1) + DbKiBuf(Db_Xferred) = InData%Gi(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Ki) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8071,8 +8488,16 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ki,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Ki)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Ki))-1 ) = PACK(InData%Ki,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Ki) + DO i4 = LBOUND(InData%Ki,4), UBOUND(InData%Ki,4) + DO i3 = LBOUND(InData%Ki,3), UBOUND(InData%Ki,3) + DO i2 = LBOUND(InData%Ki,2), UBOUND(InData%Ki,2) + DO i1 = LBOUND(InData%Ki,1), UBOUND(InData%Ki,1) + DbKiBuf(Db_Xferred) = InData%Ki(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Mi) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8093,8 +8518,16 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Mi,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Mi)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Mi))-1 ) = PACK(InData%Mi,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Mi) + DO i4 = LBOUND(InData%Mi,4), UBOUND(InData%Mi,4) + DO i3 = LBOUND(InData%Mi,3), UBOUND(InData%Mi,3) + DO i2 = LBOUND(InData%Mi,2), UBOUND(InData%Mi,2) + DO i1 = LBOUND(InData%Mi,1), UBOUND(InData%Mi,1) + DbKiBuf(Db_Xferred) = InData%Mi(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Oe) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8115,8 +8548,16 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Oe,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Oe)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Oe))-1 ) = PACK(InData%Oe,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Oe) + DO i4 = LBOUND(InData%Oe,4), UBOUND(InData%Oe,4) + DO i3 = LBOUND(InData%Oe,3), UBOUND(InData%Oe,3) + DO i2 = LBOUND(InData%Oe,2), UBOUND(InData%Oe,2) + DO i1 = LBOUND(InData%Oe,1), UBOUND(InData%Oe,1) + DbKiBuf(Db_Xferred) = InData%Oe(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Pe) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8137,8 +8578,16 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pe,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Pe)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Pe))-1 ) = PACK(InData%Pe,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Pe) + DO i4 = LBOUND(InData%Pe,4), UBOUND(InData%Pe,4) + DO i3 = LBOUND(InData%Pe,3), UBOUND(InData%Pe,3) + DO i2 = LBOUND(InData%Pe,2), UBOUND(InData%Pe,2) + DO i1 = LBOUND(InData%Pe,1), UBOUND(InData%Pe,1) + DbKiBuf(Db_Xferred) = InData%Pe(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Qe) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8159,8 +8608,16 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Qe,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Qe)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Qe))-1 ) = PACK(InData%Qe,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Qe) + DO i4 = LBOUND(InData%Qe,4), UBOUND(InData%Qe,4) + DO i3 = LBOUND(InData%Qe,3), UBOUND(InData%Qe,3) + DO i2 = LBOUND(InData%Qe,2), UBOUND(InData%Qe,2) + DO i1 = LBOUND(InData%Qe,1), UBOUND(InData%Qe,1) + DbKiBuf(Db_Xferred) = InData%Qe(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Gd) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8181,8 +8638,16 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Gd,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Gd)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Gd))-1 ) = PACK(InData%Gd,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Gd) + DO i4 = LBOUND(InData%Gd,4), UBOUND(InData%Gd,4) + DO i3 = LBOUND(InData%Gd,3), UBOUND(InData%Gd,3) + DO i2 = LBOUND(InData%Gd,2), UBOUND(InData%Gd,2) + DO i1 = LBOUND(InData%Gd,1), UBOUND(InData%Gd,1) + DbKiBuf(Db_Xferred) = InData%Gd(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Od) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8203,8 +8668,16 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Od,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Od)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Od))-1 ) = PACK(InData%Od,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Od) + DO i4 = LBOUND(InData%Od,4), UBOUND(InData%Od,4) + DO i3 = LBOUND(InData%Od,3), UBOUND(InData%Od,3) + DO i2 = LBOUND(InData%Od,2), UBOUND(InData%Od,2) + DO i1 = LBOUND(InData%Od,1), UBOUND(InData%Od,1) + DbKiBuf(Db_Xferred) = InData%Od(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Pd) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8225,8 +8698,16 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Pd,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Pd)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Pd))-1 ) = PACK(InData%Pd,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Pd) + DO i4 = LBOUND(InData%Pd,4), UBOUND(InData%Pd,4) + DO i3 = LBOUND(InData%Pd,3), UBOUND(InData%Pd,3) + DO i2 = LBOUND(InData%Pd,2), UBOUND(InData%Pd,2) + DO i1 = LBOUND(InData%Pd,1), UBOUND(InData%Pd,1) + DbKiBuf(Db_Xferred) = InData%Pd(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Qd) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8247,8 +8728,16 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Qd,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Qd)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Qd))-1 ) = PACK(InData%Qd,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Qd) + DO i4 = LBOUND(InData%Qd,4), UBOUND(InData%Qd,4) + DO i3 = LBOUND(InData%Qd,3), UBOUND(InData%Qd,3) + DO i2 = LBOUND(InData%Qd,2), UBOUND(InData%Qd,2) + DO i1 = LBOUND(InData%Qd,1), UBOUND(InData%Qd,1) + DbKiBuf(Db_Xferred) = InData%Qd(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Sd) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8269,8 +8758,16 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Sd,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Sd)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Sd))-1 ) = PACK(InData%Sd,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Sd) + DO i4 = LBOUND(InData%Sd,4), UBOUND(InData%Sd,4) + DO i3 = LBOUND(InData%Sd,3), UBOUND(InData%Sd,3) + DO i2 = LBOUND(InData%Sd,2), UBOUND(InData%Sd,2) + DO i1 = LBOUND(InData%Sd,1), UBOUND(InData%Sd,1) + DbKiBuf(Db_Xferred) = InData%Sd(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Xd) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8291,8 +8788,16 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Xd,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Xd)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Xd))-1 ) = PACK(InData%Xd,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Xd) + DO i4 = LBOUND(InData%Xd,4), UBOUND(InData%Xd,4) + DO i3 = LBOUND(InData%Xd,3), UBOUND(InData%Xd,3) + DO i2 = LBOUND(InData%Xd,2), UBOUND(InData%Xd,2) + DO i1 = LBOUND(InData%Xd,1), UBOUND(InData%Xd,1) + DbKiBuf(Db_Xferred) = InData%Xd(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Yd) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8313,8 +8818,16 @@ SUBROUTINE BD_PackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Yd,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Yd)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Yd))-1 ) = PACK(InData%Yd,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Yd) + DO i4 = LBOUND(InData%Yd,4), UBOUND(InData%Yd,4) + DO i3 = LBOUND(InData%Yd,3), UBOUND(InData%Yd,3) + DO i2 = LBOUND(InData%Yd,2), UBOUND(InData%Yd,2) + DO i1 = LBOUND(InData%Yd,1), UBOUND(InData%Yd,1) + DbKiBuf(Db_Xferred) = InData%Yd(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF END SUBROUTINE BD_PackEqMotionQP @@ -8331,12 +8844,6 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (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 @@ -8373,15 +8880,14 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%uuu.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%uuu)>0) OutData%uuu = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%uuu))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%uuu) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%uuu,3), UBOUND(OutData%uuu,3) + DO i2 = LBOUND(OutData%uuu,2), UBOUND(OutData%uuu,2) + DO i1 = LBOUND(OutData%uuu,1), UBOUND(OutData%uuu,1) + OutData%uuu(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! uup not allocated Int_Xferred = Int_Xferred + 1 @@ -8402,15 +8908,14 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%uup.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%uup)>0) OutData%uup = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%uup))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%uup) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%uup,3), UBOUND(OutData%uup,3) + DO i2 = LBOUND(OutData%uup,2), UBOUND(OutData%uup,2) + DO i1 = LBOUND(OutData%uup,1), UBOUND(OutData%uup,1) + OutData%uup(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! vvv not allocated Int_Xferred = Int_Xferred + 1 @@ -8431,15 +8936,14 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%vvv.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%vvv)>0) OutData%vvv = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%vvv))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%vvv) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%vvv,3), UBOUND(OutData%vvv,3) + DO i2 = LBOUND(OutData%vvv,2), UBOUND(OutData%vvv,2) + DO i1 = LBOUND(OutData%vvv,1), UBOUND(OutData%vvv,1) + OutData%vvv(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! vvp not allocated Int_Xferred = Int_Xferred + 1 @@ -8460,15 +8964,14 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%vvp.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%vvp)>0) OutData%vvp = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%vvp))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%vvp) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%vvp,3), UBOUND(OutData%vvp,3) + DO i2 = LBOUND(OutData%vvp,2), UBOUND(OutData%vvp,2) + DO i1 = LBOUND(OutData%vvp,1), UBOUND(OutData%vvp,1) + OutData%vvp(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! aaa not allocated Int_Xferred = Int_Xferred + 1 @@ -8489,15 +8992,14 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%aaa.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%aaa)>0) OutData%aaa = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%aaa))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%aaa) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%aaa,3), UBOUND(OutData%aaa,3) + DO i2 = LBOUND(OutData%aaa,2), UBOUND(OutData%aaa,2) + DO i1 = LBOUND(OutData%aaa,1), UBOUND(OutData%aaa,1) + OutData%aaa(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RR0 not allocated Int_Xferred = Int_Xferred + 1 @@ -8521,15 +9023,16 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RR0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%RR0)>0) OutData%RR0 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%RR0))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%RR0) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%RR0,4), UBOUND(OutData%RR0,4) + DO i3 = LBOUND(OutData%RR0,3), UBOUND(OutData%RR0,3) + DO i2 = LBOUND(OutData%RR0,2), UBOUND(OutData%RR0,2) + DO i1 = LBOUND(OutData%RR0,1), UBOUND(OutData%RR0,1) + OutData%RR0(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! kappa not allocated Int_Xferred = Int_Xferred + 1 @@ -8550,15 +9053,14 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%kappa.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%kappa)>0) OutData%kappa = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%kappa))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%kappa) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%kappa,3), UBOUND(OutData%kappa,3) + DO i2 = LBOUND(OutData%kappa,2), UBOUND(OutData%kappa,2) + DO i1 = LBOUND(OutData%kappa,1), UBOUND(OutData%kappa,1) + OutData%kappa(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! E1 not allocated Int_Xferred = Int_Xferred + 1 @@ -8579,15 +9081,14 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%E1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%E1)>0) OutData%E1 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%E1))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%E1) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%E1,3), UBOUND(OutData%E1,3) + DO i2 = LBOUND(OutData%E1,2), UBOUND(OutData%E1,2) + DO i1 = LBOUND(OutData%E1,1), UBOUND(OutData%E1,1) + OutData%E1(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Stif not allocated Int_Xferred = Int_Xferred + 1 @@ -8611,15 +9112,16 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Stif.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%Stif)>0) OutData%Stif = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Stif))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Stif) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%Stif,4), UBOUND(OutData%Stif,4) + DO i3 = LBOUND(OutData%Stif,3), UBOUND(OutData%Stif,3) + DO i2 = LBOUND(OutData%Stif,2), UBOUND(OutData%Stif,2) + DO i1 = LBOUND(OutData%Stif,1), UBOUND(OutData%Stif,1) + OutData%Stif(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fb not allocated Int_Xferred = Int_Xferred + 1 @@ -8640,15 +9142,14 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fb.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%Fb)>0) OutData%Fb = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Fb))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Fb) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%Fb,3), UBOUND(OutData%Fb,3) + DO i2 = LBOUND(OutData%Fb,2), UBOUND(OutData%Fb,2) + DO i1 = LBOUND(OutData%Fb,1), UBOUND(OutData%Fb,1) + OutData%Fb(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fc not allocated Int_Xferred = Int_Xferred + 1 @@ -8669,15 +9170,14 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fc.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%Fc)>0) OutData%Fc = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Fc))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Fc) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%Fc,3), UBOUND(OutData%Fc,3) + DO i2 = LBOUND(OutData%Fc,2), UBOUND(OutData%Fc,2) + DO i1 = LBOUND(OutData%Fc,1), UBOUND(OutData%Fc,1) + OutData%Fc(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fd not allocated Int_Xferred = Int_Xferred + 1 @@ -8698,15 +9198,14 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fd.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%Fd)>0) OutData%Fd = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Fd))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Fd) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%Fd,3), UBOUND(OutData%Fd,3) + DO i2 = LBOUND(OutData%Fd,2), UBOUND(OutData%Fd,2) + DO i1 = LBOUND(OutData%Fd,1), UBOUND(OutData%Fd,1) + OutData%Fd(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fg not allocated Int_Xferred = Int_Xferred + 1 @@ -8727,15 +9226,14 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fg.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%Fg)>0) OutData%Fg = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Fg))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Fg) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%Fg,3), UBOUND(OutData%Fg,3) + DO i2 = LBOUND(OutData%Fg,2), UBOUND(OutData%Fg,2) + DO i1 = LBOUND(OutData%Fg,1), UBOUND(OutData%Fg,1) + OutData%Fg(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fi not allocated Int_Xferred = Int_Xferred + 1 @@ -8756,15 +9254,14 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%Fi)>0) OutData%Fi = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Fi))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Fi) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%Fi,3), UBOUND(OutData%Fi,3) + DO i2 = LBOUND(OutData%Fi,2), UBOUND(OutData%Fi,2) + DO i1 = LBOUND(OutData%Fi,1), UBOUND(OutData%Fi,1) + OutData%Fi(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Ftemp not allocated Int_Xferred = Int_Xferred + 1 @@ -8785,15 +9282,14 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ftemp.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%Ftemp)>0) OutData%Ftemp = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Ftemp))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Ftemp) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%Ftemp,3), UBOUND(OutData%Ftemp,3) + DO i2 = LBOUND(OutData%Ftemp,2), UBOUND(OutData%Ftemp,2) + DO i1 = LBOUND(OutData%Ftemp,1), UBOUND(OutData%Ftemp,1) + OutData%Ftemp(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RR0mEta not allocated Int_Xferred = Int_Xferred + 1 @@ -8814,15 +9310,14 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RR0mEta.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%RR0mEta)>0) OutData%RR0mEta = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%RR0mEta))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%RR0mEta) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%RR0mEta,3), UBOUND(OutData%RR0mEta,3) + DO i2 = LBOUND(OutData%RR0mEta,2), UBOUND(OutData%RR0mEta,2) + DO i1 = LBOUND(OutData%RR0mEta,1), UBOUND(OutData%RR0mEta,1) + OutData%RR0mEta(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rho not allocated Int_Xferred = Int_Xferred + 1 @@ -8846,15 +9341,16 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rho.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%rho)>0) OutData%rho = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rho))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rho) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%rho,4), UBOUND(OutData%rho,4) + DO i3 = LBOUND(OutData%rho,3), UBOUND(OutData%rho,3) + DO i2 = LBOUND(OutData%rho,2), UBOUND(OutData%rho,2) + DO i1 = LBOUND(OutData%rho,1), UBOUND(OutData%rho,1) + OutData%rho(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! betaC not allocated Int_Xferred = Int_Xferred + 1 @@ -8878,15 +9374,16 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%betaC.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%betaC)>0) OutData%betaC = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%betaC))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%betaC) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%betaC,4), UBOUND(OutData%betaC,4) + DO i3 = LBOUND(OutData%betaC,3), UBOUND(OutData%betaC,3) + DO i2 = LBOUND(OutData%betaC,2), UBOUND(OutData%betaC,2) + DO i1 = LBOUND(OutData%betaC,1), UBOUND(OutData%betaC,1) + OutData%betaC(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Gi not allocated Int_Xferred = Int_Xferred + 1 @@ -8910,15 +9407,16 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Gi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%Gi)>0) OutData%Gi = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Gi))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Gi) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%Gi,4), UBOUND(OutData%Gi,4) + DO i3 = LBOUND(OutData%Gi,3), UBOUND(OutData%Gi,3) + DO i2 = LBOUND(OutData%Gi,2), UBOUND(OutData%Gi,2) + DO i1 = LBOUND(OutData%Gi,1), UBOUND(OutData%Gi,1) + OutData%Gi(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Ki not allocated Int_Xferred = Int_Xferred + 1 @@ -8942,15 +9440,16 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ki.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%Ki)>0) OutData%Ki = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Ki))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Ki) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%Ki,4), UBOUND(OutData%Ki,4) + DO i3 = LBOUND(OutData%Ki,3), UBOUND(OutData%Ki,3) + DO i2 = LBOUND(OutData%Ki,2), UBOUND(OutData%Ki,2) + DO i1 = LBOUND(OutData%Ki,1), UBOUND(OutData%Ki,1) + OutData%Ki(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Mi not allocated Int_Xferred = Int_Xferred + 1 @@ -8974,15 +9473,16 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%Mi)>0) OutData%Mi = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Mi))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Mi) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%Mi,4), UBOUND(OutData%Mi,4) + DO i3 = LBOUND(OutData%Mi,3), UBOUND(OutData%Mi,3) + DO i2 = LBOUND(OutData%Mi,2), UBOUND(OutData%Mi,2) + DO i1 = LBOUND(OutData%Mi,1), UBOUND(OutData%Mi,1) + OutData%Mi(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Oe not allocated Int_Xferred = Int_Xferred + 1 @@ -9006,15 +9506,16 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Oe.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%Oe)>0) OutData%Oe = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Oe))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Oe) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%Oe,4), UBOUND(OutData%Oe,4) + DO i3 = LBOUND(OutData%Oe,3), UBOUND(OutData%Oe,3) + DO i2 = LBOUND(OutData%Oe,2), UBOUND(OutData%Oe,2) + DO i1 = LBOUND(OutData%Oe,1), UBOUND(OutData%Oe,1) + OutData%Oe(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Pe not allocated Int_Xferred = Int_Xferred + 1 @@ -9038,15 +9539,16 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Pe.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%Pe)>0) OutData%Pe = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Pe))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Pe) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%Pe,4), UBOUND(OutData%Pe,4) + DO i3 = LBOUND(OutData%Pe,3), UBOUND(OutData%Pe,3) + DO i2 = LBOUND(OutData%Pe,2), UBOUND(OutData%Pe,2) + DO i1 = LBOUND(OutData%Pe,1), UBOUND(OutData%Pe,1) + OutData%Pe(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Qe not allocated Int_Xferred = Int_Xferred + 1 @@ -9070,15 +9572,16 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Qe.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%Qe)>0) OutData%Qe = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Qe))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Qe) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%Qe,4), UBOUND(OutData%Qe,4) + DO i3 = LBOUND(OutData%Qe,3), UBOUND(OutData%Qe,3) + DO i2 = LBOUND(OutData%Qe,2), UBOUND(OutData%Qe,2) + DO i1 = LBOUND(OutData%Qe,1), UBOUND(OutData%Qe,1) + OutData%Qe(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Gd not allocated Int_Xferred = Int_Xferred + 1 @@ -9102,15 +9605,16 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Gd.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%Gd)>0) OutData%Gd = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Gd))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Gd) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%Gd,4), UBOUND(OutData%Gd,4) + DO i3 = LBOUND(OutData%Gd,3), UBOUND(OutData%Gd,3) + DO i2 = LBOUND(OutData%Gd,2), UBOUND(OutData%Gd,2) + DO i1 = LBOUND(OutData%Gd,1), UBOUND(OutData%Gd,1) + OutData%Gd(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Od not allocated Int_Xferred = Int_Xferred + 1 @@ -9134,15 +9638,16 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Od.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%Od)>0) OutData%Od = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Od))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Od) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%Od,4), UBOUND(OutData%Od,4) + DO i3 = LBOUND(OutData%Od,3), UBOUND(OutData%Od,3) + DO i2 = LBOUND(OutData%Od,2), UBOUND(OutData%Od,2) + DO i1 = LBOUND(OutData%Od,1), UBOUND(OutData%Od,1) + OutData%Od(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Pd not allocated Int_Xferred = Int_Xferred + 1 @@ -9166,15 +9671,16 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Pd.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%Pd)>0) OutData%Pd = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Pd))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Pd) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%Pd,4), UBOUND(OutData%Pd,4) + DO i3 = LBOUND(OutData%Pd,3), UBOUND(OutData%Pd,3) + DO i2 = LBOUND(OutData%Pd,2), UBOUND(OutData%Pd,2) + DO i1 = LBOUND(OutData%Pd,1), UBOUND(OutData%Pd,1) + OutData%Pd(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Qd not allocated Int_Xferred = Int_Xferred + 1 @@ -9198,15 +9704,16 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Qd.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%Qd)>0) OutData%Qd = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Qd))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Qd) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%Qd,4), UBOUND(OutData%Qd,4) + DO i3 = LBOUND(OutData%Qd,3), UBOUND(OutData%Qd,3) + DO i2 = LBOUND(OutData%Qd,2), UBOUND(OutData%Qd,2) + DO i1 = LBOUND(OutData%Qd,1), UBOUND(OutData%Qd,1) + OutData%Qd(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Sd not allocated Int_Xferred = Int_Xferred + 1 @@ -9230,15 +9737,16 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Sd.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%Sd)>0) OutData%Sd = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Sd))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Sd) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%Sd,4), UBOUND(OutData%Sd,4) + DO i3 = LBOUND(OutData%Sd,3), UBOUND(OutData%Sd,3) + DO i2 = LBOUND(OutData%Sd,2), UBOUND(OutData%Sd,2) + DO i1 = LBOUND(OutData%Sd,1), UBOUND(OutData%Sd,1) + OutData%Sd(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Xd not allocated Int_Xferred = Int_Xferred + 1 @@ -9262,15 +9770,16 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Xd.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%Xd)>0) OutData%Xd = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Xd))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Xd) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%Xd,4), UBOUND(OutData%Xd,4) + DO i3 = LBOUND(OutData%Xd,3), UBOUND(OutData%Xd,3) + DO i2 = LBOUND(OutData%Xd,2), UBOUND(OutData%Xd,2) + DO i1 = LBOUND(OutData%Xd,1), UBOUND(OutData%Xd,1) + OutData%Xd(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Yd not allocated Int_Xferred = Int_Xferred + 1 @@ -9294,15 +9803,16 @@ SUBROUTINE BD_UnPackEqMotionQP( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Yd.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%Yd)>0) OutData%Yd = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Yd))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Yd) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%Yd,4), UBOUND(OutData%Yd,4) + DO i3 = LBOUND(OutData%Yd,3), UBOUND(OutData%Yd,3) + DO i2 = LBOUND(OutData%Yd,2), UBOUND(OutData%Yd,2) + DO i1 = LBOUND(OutData%Yd,1), UBOUND(OutData%Yd,1) + OutData%Yd(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF END SUBROUTINE BD_UnPackEqMotionQP @@ -10355,8 +10865,8 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Un_Sum - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Un_Sum + Int_Xferred = Int_Xferred + 1 CALL BD_Packeqmotionqp( Re_Buf, Db_Buf, Int_Buf, InData%qp, ErrStat2, ErrMsg2, OnlySize ) ! qp CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -10398,8 +10908,12 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%lin_A,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%lin_A)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%lin_A))-1 ) = PACK(InData%lin_A,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%lin_A) + DO i2 = LBOUND(InData%lin_A,2), UBOUND(InData%lin_A,2) + DO i1 = LBOUND(InData%lin_A,1), UBOUND(InData%lin_A,1) + DbKiBuf(Db_Xferred) = InData%lin_A(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%lin_C) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10414,8 +10928,12 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%lin_C,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%lin_C)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%lin_C))-1 ) = PACK(InData%lin_C,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%lin_C) + DO i2 = LBOUND(InData%lin_C,2), UBOUND(InData%lin_C,2) + DO i1 = LBOUND(InData%lin_C,1), UBOUND(InData%lin_C,1) + DbKiBuf(Db_Xferred) = InData%lin_C(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Nrrr) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10433,8 +10951,14 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nrrr,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Nrrr)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Nrrr))-1 ) = PACK(InData%Nrrr,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Nrrr) + DO i3 = LBOUND(InData%Nrrr,3), UBOUND(InData%Nrrr,3) + DO i2 = LBOUND(InData%Nrrr,2), UBOUND(InData%Nrrr,2) + DO i1 = LBOUND(InData%Nrrr,1), UBOUND(InData%Nrrr,1) + DbKiBuf(Db_Xferred) = InData%Nrrr(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%elf) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10449,8 +10973,12 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%elf,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%elf)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%elf))-1 ) = PACK(InData%elf,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%elf) + DO i2 = LBOUND(InData%elf,2), UBOUND(InData%elf,2) + DO i1 = LBOUND(InData%elf,1), UBOUND(InData%elf,1) + DbKiBuf(Db_Xferred) = InData%elf(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%EFint) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10468,8 +10996,14 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%EFint,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%EFint)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%EFint))-1 ) = PACK(InData%EFint,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%EFint) + DO i3 = LBOUND(InData%EFint,3), UBOUND(InData%EFint,3) + DO i2 = LBOUND(InData%EFint,2), UBOUND(InData%EFint,2) + DO i1 = LBOUND(InData%EFint,1), UBOUND(InData%EFint,1) + DbKiBuf(Db_Xferred) = InData%EFint(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%elk) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10490,8 +11024,16 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%elk,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%elk)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%elk))-1 ) = PACK(InData%elk,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%elk) + DO i4 = LBOUND(InData%elk,4), UBOUND(InData%elk,4) + DO i3 = LBOUND(InData%elk,3), UBOUND(InData%elk,3) + DO i2 = LBOUND(InData%elk,2), UBOUND(InData%elk,2) + DO i1 = LBOUND(InData%elk,1), UBOUND(InData%elk,1) + DbKiBuf(Db_Xferred) = InData%elk(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%elg) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10512,8 +11054,16 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%elg,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%elg)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%elg))-1 ) = PACK(InData%elg,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%elg) + DO i4 = LBOUND(InData%elg,4), UBOUND(InData%elg,4) + DO i3 = LBOUND(InData%elg,3), UBOUND(InData%elg,3) + DO i2 = LBOUND(InData%elg,2), UBOUND(InData%elg,2) + DO i1 = LBOUND(InData%elg,1), UBOUND(InData%elg,1) + DbKiBuf(Db_Xferred) = InData%elg(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%elm) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10534,8 +11084,16 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%elm,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%elm)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%elm))-1 ) = PACK(InData%elm,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%elm) + DO i4 = LBOUND(InData%elm,4), UBOUND(InData%elm,4) + DO i3 = LBOUND(InData%elm,3), UBOUND(InData%elm,3) + DO i2 = LBOUND(InData%elm,2), UBOUND(InData%elm,2) + DO i1 = LBOUND(InData%elm,1), UBOUND(InData%elm,1) + DbKiBuf(Db_Xferred) = InData%elm(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%DistrLoad_QP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10553,8 +11111,14 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DistrLoad_QP,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DistrLoad_QP)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%DistrLoad_QP))-1 ) = PACK(InData%DistrLoad_QP,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%DistrLoad_QP) + DO i3 = LBOUND(InData%DistrLoad_QP,3), UBOUND(InData%DistrLoad_QP,3) + DO i2 = LBOUND(InData%DistrLoad_QP,2), UBOUND(InData%DistrLoad_QP,2) + DO i1 = LBOUND(InData%DistrLoad_QP,1), UBOUND(InData%DistrLoad_QP,1) + DbKiBuf(Db_Xferred) = InData%DistrLoad_QP(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PointLoadLcl) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10569,8 +11133,12 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PointLoadLcl,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PointLoadLcl)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%PointLoadLcl))-1 ) = PACK(InData%PointLoadLcl,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%PointLoadLcl) + DO i2 = LBOUND(InData%PointLoadLcl,2), UBOUND(InData%PointLoadLcl,2) + DO i1 = LBOUND(InData%PointLoadLcl,1), UBOUND(InData%PointLoadLcl,1) + DbKiBuf(Db_Xferred) = InData%PointLoadLcl(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%StifK) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10591,8 +11159,16 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StifK,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%StifK)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%StifK))-1 ) = PACK(InData%StifK,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%StifK) + DO i4 = LBOUND(InData%StifK,4), UBOUND(InData%StifK,4) + DO i3 = LBOUND(InData%StifK,3), UBOUND(InData%StifK,3) + DO i2 = LBOUND(InData%StifK,2), UBOUND(InData%StifK,2) + DO i1 = LBOUND(InData%StifK,1), UBOUND(InData%StifK,1) + DbKiBuf(Db_Xferred) = InData%StifK(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%MassM) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10613,8 +11189,16 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MassM,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%MassM)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%MassM))-1 ) = PACK(InData%MassM,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%MassM) + DO i4 = LBOUND(InData%MassM,4), UBOUND(InData%MassM,4) + DO i3 = LBOUND(InData%MassM,3), UBOUND(InData%MassM,3) + DO i2 = LBOUND(InData%MassM,2), UBOUND(InData%MassM,2) + DO i1 = LBOUND(InData%MassM,1), UBOUND(InData%MassM,1) + DbKiBuf(Db_Xferred) = InData%MassM(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%DampG) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10635,8 +11219,16 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DampG,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DampG)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%DampG))-1 ) = PACK(InData%DampG,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%DampG) + DO i4 = LBOUND(InData%DampG,4), UBOUND(InData%DampG,4) + DO i3 = LBOUND(InData%DampG,3), UBOUND(InData%DampG,3) + DO i2 = LBOUND(InData%DampG,2), UBOUND(InData%DampG,2) + DO i1 = LBOUND(InData%DampG,1), UBOUND(InData%DampG,1) + DbKiBuf(Db_Xferred) = InData%DampG(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%StifK_fd) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10657,8 +11249,16 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StifK_fd,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%StifK_fd)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%StifK_fd))-1 ) = PACK(InData%StifK_fd,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%StifK_fd) + DO i4 = LBOUND(InData%StifK_fd,4), UBOUND(InData%StifK_fd,4) + DO i3 = LBOUND(InData%StifK_fd,3), UBOUND(InData%StifK_fd,3) + DO i2 = LBOUND(InData%StifK_fd,2), UBOUND(InData%StifK_fd,2) + DO i1 = LBOUND(InData%StifK_fd,1), UBOUND(InData%StifK_fd,1) + DbKiBuf(Db_Xferred) = InData%StifK_fd(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%MassM_fd) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10679,8 +11279,16 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MassM_fd,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%MassM_fd)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%MassM_fd))-1 ) = PACK(InData%MassM_fd,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%MassM_fd) + DO i4 = LBOUND(InData%MassM_fd,4), UBOUND(InData%MassM_fd,4) + DO i3 = LBOUND(InData%MassM_fd,3), UBOUND(InData%MassM_fd,3) + DO i2 = LBOUND(InData%MassM_fd,2), UBOUND(InData%MassM_fd,2) + DO i1 = LBOUND(InData%MassM_fd,1), UBOUND(InData%MassM_fd,1) + DbKiBuf(Db_Xferred) = InData%MassM_fd(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%DampG_fd) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10701,8 +11309,16 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DampG_fd,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DampG_fd)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%DampG_fd))-1 ) = PACK(InData%DampG_fd,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%DampG_fd) + DO i4 = LBOUND(InData%DampG_fd,4), UBOUND(InData%DampG_fd,4) + DO i3 = LBOUND(InData%DampG_fd,3), UBOUND(InData%DampG_fd,3) + DO i2 = LBOUND(InData%DampG_fd,2), UBOUND(InData%DampG_fd,2) + DO i1 = LBOUND(InData%DampG_fd,1), UBOUND(InData%DampG_fd,1) + DbKiBuf(Db_Xferred) = InData%DampG_fd(i1,i2,i3,i4) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%RHS) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10717,8 +11333,12 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RHS,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RHS)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%RHS))-1 ) = PACK(InData%RHS,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%RHS) + DO i2 = LBOUND(InData%RHS,2), UBOUND(InData%RHS,2) + DO i1 = LBOUND(InData%RHS,1), UBOUND(InData%RHS,1) + DbKiBuf(Db_Xferred) = InData%RHS(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%RHS_p) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10733,8 +11353,12 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RHS_p,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RHS_p)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%RHS_p))-1 ) = PACK(InData%RHS_p,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%RHS_p) + DO i2 = LBOUND(InData%RHS_p,2), UBOUND(InData%RHS_p,2) + DO i1 = LBOUND(InData%RHS_p,1), UBOUND(InData%RHS_p,1) + DbKiBuf(Db_Xferred) = InData%RHS_p(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%RHS_m) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10749,8 +11373,12 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RHS_m,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RHS_m)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%RHS_m))-1 ) = PACK(InData%RHS_m,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%RHS_m) + DO i2 = LBOUND(InData%RHS_m,2), UBOUND(InData%RHS_m,2) + DO i1 = LBOUND(InData%RHS_m,1), UBOUND(InData%RHS_m,1) + DbKiBuf(Db_Xferred) = InData%RHS_m(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%BldInternalForceFE) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10765,8 +11393,12 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldInternalForceFE,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BldInternalForceFE)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%BldInternalForceFE))-1 ) = PACK(InData%BldInternalForceFE,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%BldInternalForceFE) + DO i2 = LBOUND(InData%BldInternalForceFE,2), UBOUND(InData%BldInternalForceFE,2) + DO i1 = LBOUND(InData%BldInternalForceFE,1), UBOUND(InData%BldInternalForceFE,1) + DbKiBuf(Db_Xferred) = InData%BldInternalForceFE(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%BldInternalForceQP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10781,8 +11413,12 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldInternalForceQP,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BldInternalForceQP)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%BldInternalForceQP))-1 ) = PACK(InData%BldInternalForceQP,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%BldInternalForceQP) + DO i2 = LBOUND(InData%BldInternalForceQP,2), UBOUND(InData%BldInternalForceQP,2) + DO i1 = LBOUND(InData%BldInternalForceQP,1), UBOUND(InData%BldInternalForceQP,1) + DbKiBuf(Db_Xferred) = InData%BldInternalForceQP(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%FirstNodeReactionLclForceMoment) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10794,8 +11430,10 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FirstNodeReactionLclForceMoment,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FirstNodeReactionLclForceMoment)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%FirstNodeReactionLclForceMoment))-1 ) = PACK(InData%FirstNodeReactionLclForceMoment,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%FirstNodeReactionLclForceMoment) + DO i1 = LBOUND(InData%FirstNodeReactionLclForceMoment,1), UBOUND(InData%FirstNodeReactionLclForceMoment,1) + DbKiBuf(Db_Xferred) = InData%FirstNodeReactionLclForceMoment(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%Solution) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10810,8 +11448,12 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Solution,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Solution)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Solution))-1 ) = PACK(InData%Solution,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Solution) + DO i2 = LBOUND(InData%Solution,2), UBOUND(InData%Solution,2) + DO i1 = LBOUND(InData%Solution,1), UBOUND(InData%Solution,1) + DbKiBuf(Db_Xferred) = InData%Solution(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%LP_StifK) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10826,8 +11468,12 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LP_StifK,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LP_StifK)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%LP_StifK))-1 ) = PACK(InData%LP_StifK,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%LP_StifK) + DO i2 = LBOUND(InData%LP_StifK,2), UBOUND(InData%LP_StifK,2) + DO i1 = LBOUND(InData%LP_StifK,1), UBOUND(InData%LP_StifK,1) + DbKiBuf(Db_Xferred) = InData%LP_StifK(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%LP_MassM) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10842,8 +11488,12 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LP_MassM,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LP_MassM)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%LP_MassM))-1 ) = PACK(InData%LP_MassM,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%LP_MassM) + DO i2 = LBOUND(InData%LP_MassM,2), UBOUND(InData%LP_MassM,2) + DO i1 = LBOUND(InData%LP_MassM,1), UBOUND(InData%LP_MassM,1) + DbKiBuf(Db_Xferred) = InData%LP_MassM(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%LP_MassM_LU) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10858,8 +11508,12 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LP_MassM_LU,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LP_MassM_LU)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%LP_MassM_LU))-1 ) = PACK(InData%LP_MassM_LU,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%LP_MassM_LU) + DO i2 = LBOUND(InData%LP_MassM_LU,2), UBOUND(InData%LP_MassM_LU,2) + DO i1 = LBOUND(InData%LP_MassM_LU,1), UBOUND(InData%LP_MassM_LU,1) + DbKiBuf(Db_Xferred) = InData%LP_MassM_LU(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%LP_RHS) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10871,8 +11525,10 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LP_RHS,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LP_RHS)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%LP_RHS))-1 ) = PACK(InData%LP_RHS,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%LP_RHS) + DO i1 = LBOUND(InData%LP_RHS,1), UBOUND(InData%LP_RHS,1) + DbKiBuf(Db_Xferred) = InData%LP_RHS(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LP_StifK_LU) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10887,8 +11543,12 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LP_StifK_LU,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LP_StifK_LU)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%LP_StifK_LU))-1 ) = PACK(InData%LP_StifK_LU,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%LP_StifK_LU) + DO i2 = LBOUND(InData%LP_StifK_LU,2), UBOUND(InData%LP_StifK_LU,2) + DO i1 = LBOUND(InData%LP_StifK_LU,1), UBOUND(InData%LP_StifK_LU,1) + DbKiBuf(Db_Xferred) = InData%LP_StifK_LU(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%LP_RHS_LU) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10900,8 +11560,10 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LP_RHS_LU,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LP_RHS_LU)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%LP_RHS_LU))-1 ) = PACK(InData%LP_RHS_LU,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%LP_RHS_LU) + DO i1 = LBOUND(InData%LP_RHS_LU,1), UBOUND(InData%LP_RHS_LU,1) + DbKiBuf(Db_Xferred) = InData%LP_RHS_LU(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LP_indx) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10913,8 +11575,10 @@ SUBROUTINE BD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LP_indx,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LP_indx)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%LP_indx))-1 ) = PACK(InData%LP_indx,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%LP_indx) + DO i1 = LBOUND(InData%LP_indx,1), UBOUND(InData%LP_indx,1) + IntKiBuf(Int_Xferred) = InData%LP_indx(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF CALL BD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -10987,12 +11651,6 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (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 @@ -11170,8 +11828,8 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%Un_Sum = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%Un_Sum = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -11228,15 +11886,12 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%lin_A.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%lin_A)>0) OutData%lin_A = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%lin_A))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%lin_A) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%lin_A,2), UBOUND(OutData%lin_A,2) + DO i1 = LBOUND(OutData%lin_A,1), UBOUND(OutData%lin_A,1) + OutData%lin_A(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! lin_C not allocated Int_Xferred = Int_Xferred + 1 @@ -11254,15 +11909,12 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%lin_C.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%lin_C)>0) OutData%lin_C = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%lin_C))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%lin_C) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%lin_C,2), UBOUND(OutData%lin_C,2) + DO i1 = LBOUND(OutData%lin_C,1), UBOUND(OutData%lin_C,1) + OutData%lin_C(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Nrrr not allocated Int_Xferred = Int_Xferred + 1 @@ -11283,15 +11935,14 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nrrr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%Nrrr)>0) OutData%Nrrr = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Nrrr))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Nrrr) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%Nrrr,3), UBOUND(OutData%Nrrr,3) + DO i2 = LBOUND(OutData%Nrrr,2), UBOUND(OutData%Nrrr,2) + DO i1 = LBOUND(OutData%Nrrr,1), UBOUND(OutData%Nrrr,1) + OutData%Nrrr(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! elf not allocated Int_Xferred = Int_Xferred + 1 @@ -11309,15 +11960,12 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%elf.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%elf)>0) OutData%elf = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%elf))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%elf) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%elf,2), UBOUND(OutData%elf,2) + DO i1 = LBOUND(OutData%elf,1), UBOUND(OutData%elf,1) + OutData%elf(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! EFint not allocated Int_Xferred = Int_Xferred + 1 @@ -11338,15 +11986,14 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%EFint.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%EFint)>0) OutData%EFint = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%EFint))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%EFint) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%EFint,3), UBOUND(OutData%EFint,3) + DO i2 = LBOUND(OutData%EFint,2), UBOUND(OutData%EFint,2) + DO i1 = LBOUND(OutData%EFint,1), UBOUND(OutData%EFint,1) + OutData%EFint(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! elk not allocated Int_Xferred = Int_Xferred + 1 @@ -11370,15 +12017,16 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%elk.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%elk)>0) OutData%elk = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%elk))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%elk) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%elk,4), UBOUND(OutData%elk,4) + DO i3 = LBOUND(OutData%elk,3), UBOUND(OutData%elk,3) + DO i2 = LBOUND(OutData%elk,2), UBOUND(OutData%elk,2) + DO i1 = LBOUND(OutData%elk,1), UBOUND(OutData%elk,1) + OutData%elk(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! elg not allocated Int_Xferred = Int_Xferred + 1 @@ -11402,15 +12050,16 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%elg.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%elg)>0) OutData%elg = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%elg))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%elg) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%elg,4), UBOUND(OutData%elg,4) + DO i3 = LBOUND(OutData%elg,3), UBOUND(OutData%elg,3) + DO i2 = LBOUND(OutData%elg,2), UBOUND(OutData%elg,2) + DO i1 = LBOUND(OutData%elg,1), UBOUND(OutData%elg,1) + OutData%elg(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! elm not allocated Int_Xferred = Int_Xferred + 1 @@ -11434,15 +12083,16 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%elm.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%elm)>0) OutData%elm = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%elm))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%elm) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%elm,4), UBOUND(OutData%elm,4) + DO i3 = LBOUND(OutData%elm,3), UBOUND(OutData%elm,3) + DO i2 = LBOUND(OutData%elm,2), UBOUND(OutData%elm,2) + DO i1 = LBOUND(OutData%elm,1), UBOUND(OutData%elm,1) + OutData%elm(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DistrLoad_QP not allocated Int_Xferred = Int_Xferred + 1 @@ -11463,15 +12113,14 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DistrLoad_QP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%DistrLoad_QP)>0) OutData%DistrLoad_QP = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%DistrLoad_QP))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%DistrLoad_QP) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%DistrLoad_QP,3), UBOUND(OutData%DistrLoad_QP,3) + DO i2 = LBOUND(OutData%DistrLoad_QP,2), UBOUND(OutData%DistrLoad_QP,2) + DO i1 = LBOUND(OutData%DistrLoad_QP,1), UBOUND(OutData%DistrLoad_QP,1) + OutData%DistrLoad_QP(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PointLoadLcl not allocated Int_Xferred = Int_Xferred + 1 @@ -11489,15 +12138,12 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PointLoadLcl.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PointLoadLcl)>0) OutData%PointLoadLcl = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%PointLoadLcl))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%PointLoadLcl) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PointLoadLcl,2), UBOUND(OutData%PointLoadLcl,2) + DO i1 = LBOUND(OutData%PointLoadLcl,1), UBOUND(OutData%PointLoadLcl,1) + OutData%PointLoadLcl(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StifK not allocated Int_Xferred = Int_Xferred + 1 @@ -11521,15 +12167,16 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StifK.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%StifK)>0) OutData%StifK = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%StifK))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%StifK) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%StifK,4), UBOUND(OutData%StifK,4) + DO i3 = LBOUND(OutData%StifK,3), UBOUND(OutData%StifK,3) + DO i2 = LBOUND(OutData%StifK,2), UBOUND(OutData%StifK,2) + DO i1 = LBOUND(OutData%StifK,1), UBOUND(OutData%StifK,1) + OutData%StifK(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MassM not allocated Int_Xferred = Int_Xferred + 1 @@ -11553,15 +12200,16 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MassM.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%MassM)>0) OutData%MassM = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%MassM))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%MassM) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%MassM,4), UBOUND(OutData%MassM,4) + DO i3 = LBOUND(OutData%MassM,3), UBOUND(OutData%MassM,3) + DO i2 = LBOUND(OutData%MassM,2), UBOUND(OutData%MassM,2) + DO i1 = LBOUND(OutData%MassM,1), UBOUND(OutData%MassM,1) + OutData%MassM(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DampG not allocated Int_Xferred = Int_Xferred + 1 @@ -11585,15 +12233,16 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DampG.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%DampG)>0) OutData%DampG = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%DampG))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%DampG) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%DampG,4), UBOUND(OutData%DampG,4) + DO i3 = LBOUND(OutData%DampG,3), UBOUND(OutData%DampG,3) + DO i2 = LBOUND(OutData%DampG,2), UBOUND(OutData%DampG,2) + DO i1 = LBOUND(OutData%DampG,1), UBOUND(OutData%DampG,1) + OutData%DampG(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StifK_fd not allocated Int_Xferred = Int_Xferred + 1 @@ -11617,15 +12266,16 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StifK_fd.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%StifK_fd)>0) OutData%StifK_fd = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%StifK_fd))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%StifK_fd) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%StifK_fd,4), UBOUND(OutData%StifK_fd,4) + DO i3 = LBOUND(OutData%StifK_fd,3), UBOUND(OutData%StifK_fd,3) + DO i2 = LBOUND(OutData%StifK_fd,2), UBOUND(OutData%StifK_fd,2) + DO i1 = LBOUND(OutData%StifK_fd,1), UBOUND(OutData%StifK_fd,1) + OutData%StifK_fd(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MassM_fd not allocated Int_Xferred = Int_Xferred + 1 @@ -11649,15 +12299,16 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MassM_fd.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%MassM_fd)>0) OutData%MassM_fd = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%MassM_fd))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%MassM_fd) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%MassM_fd,4), UBOUND(OutData%MassM_fd,4) + DO i3 = LBOUND(OutData%MassM_fd,3), UBOUND(OutData%MassM_fd,3) + DO i2 = LBOUND(OutData%MassM_fd,2), UBOUND(OutData%MassM_fd,2) + DO i1 = LBOUND(OutData%MassM_fd,1), UBOUND(OutData%MassM_fd,1) + OutData%MassM_fd(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DampG_fd not allocated Int_Xferred = Int_Xferred + 1 @@ -11681,15 +12332,16 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DampG_fd.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%DampG_fd)>0) OutData%DampG_fd = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%DampG_fd))-1 ), mask4, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%DampG_fd) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%DampG_fd,4), UBOUND(OutData%DampG_fd,4) + DO i3 = LBOUND(OutData%DampG_fd,3), UBOUND(OutData%DampG_fd,3) + DO i2 = LBOUND(OutData%DampG_fd,2), UBOUND(OutData%DampG_fd,2) + DO i1 = LBOUND(OutData%DampG_fd,1), UBOUND(OutData%DampG_fd,1) + OutData%DampG_fd(i1,i2,i3,i4) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RHS not allocated Int_Xferred = Int_Xferred + 1 @@ -11707,15 +12359,12 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RHS.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%RHS)>0) OutData%RHS = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%RHS))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%RHS) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%RHS,2), UBOUND(OutData%RHS,2) + DO i1 = LBOUND(OutData%RHS,1), UBOUND(OutData%RHS,1) + OutData%RHS(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RHS_p not allocated Int_Xferred = Int_Xferred + 1 @@ -11733,15 +12382,12 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RHS_p.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%RHS_p)>0) OutData%RHS_p = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%RHS_p))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%RHS_p) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%RHS_p,2), UBOUND(OutData%RHS_p,2) + DO i1 = LBOUND(OutData%RHS_p,1), UBOUND(OutData%RHS_p,1) + OutData%RHS_p(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RHS_m not allocated Int_Xferred = Int_Xferred + 1 @@ -11759,15 +12405,12 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RHS_m.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%RHS_m)>0) OutData%RHS_m = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%RHS_m))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%RHS_m) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%RHS_m,2), UBOUND(OutData%RHS_m,2) + DO i1 = LBOUND(OutData%RHS_m,1), UBOUND(OutData%RHS_m,1) + OutData%RHS_m(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldInternalForceFE not allocated Int_Xferred = Int_Xferred + 1 @@ -11785,15 +12428,12 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldInternalForceFE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%BldInternalForceFE)>0) OutData%BldInternalForceFE = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%BldInternalForceFE))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%BldInternalForceFE) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%BldInternalForceFE,2), UBOUND(OutData%BldInternalForceFE,2) + DO i1 = LBOUND(OutData%BldInternalForceFE,1), UBOUND(OutData%BldInternalForceFE,1) + OutData%BldInternalForceFE(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldInternalForceQP not allocated Int_Xferred = Int_Xferred + 1 @@ -11811,15 +12451,12 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldInternalForceQP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%BldInternalForceQP)>0) OutData%BldInternalForceQP = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%BldInternalForceQP))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%BldInternalForceQP) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%BldInternalForceQP,2), UBOUND(OutData%BldInternalForceQP,2) + DO i1 = LBOUND(OutData%BldInternalForceQP,1), UBOUND(OutData%BldInternalForceQP,1) + OutData%BldInternalForceQP(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FirstNodeReactionLclForceMoment not allocated Int_Xferred = Int_Xferred + 1 @@ -11834,15 +12471,10 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FirstNodeReactionLclForceMoment.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%FirstNodeReactionLclForceMoment)>0) OutData%FirstNodeReactionLclForceMoment = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%FirstNodeReactionLclForceMoment))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%FirstNodeReactionLclForceMoment) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FirstNodeReactionLclForceMoment,1), UBOUND(OutData%FirstNodeReactionLclForceMoment,1) + OutData%FirstNodeReactionLclForceMoment(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Solution not allocated Int_Xferred = Int_Xferred + 1 @@ -11860,15 +12492,12 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Solution.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Solution)>0) OutData%Solution = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Solution))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%Solution) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Solution,2), UBOUND(OutData%Solution,2) + DO i1 = LBOUND(OutData%Solution,1), UBOUND(OutData%Solution,1) + OutData%Solution(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LP_StifK not allocated Int_Xferred = Int_Xferred + 1 @@ -11886,15 +12515,12 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LP_StifK.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%LP_StifK)>0) OutData%LP_StifK = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%LP_StifK))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%LP_StifK) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%LP_StifK,2), UBOUND(OutData%LP_StifK,2) + DO i1 = LBOUND(OutData%LP_StifK,1), UBOUND(OutData%LP_StifK,1) + OutData%LP_StifK(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LP_MassM not allocated Int_Xferred = Int_Xferred + 1 @@ -11912,15 +12538,12 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LP_MassM.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%LP_MassM)>0) OutData%LP_MassM = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%LP_MassM))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%LP_MassM) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%LP_MassM,2), UBOUND(OutData%LP_MassM,2) + DO i1 = LBOUND(OutData%LP_MassM,1), UBOUND(OutData%LP_MassM,1) + OutData%LP_MassM(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LP_MassM_LU not allocated Int_Xferred = Int_Xferred + 1 @@ -11938,15 +12561,12 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LP_MassM_LU.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%LP_MassM_LU)>0) OutData%LP_MassM_LU = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%LP_MassM_LU))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%LP_MassM_LU) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%LP_MassM_LU,2), UBOUND(OutData%LP_MassM_LU,2) + DO i1 = LBOUND(OutData%LP_MassM_LU,1), UBOUND(OutData%LP_MassM_LU,1) + OutData%LP_MassM_LU(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LP_RHS not allocated Int_Xferred = Int_Xferred + 1 @@ -11961,15 +12581,10 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LP_RHS.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LP_RHS)>0) OutData%LP_RHS = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%LP_RHS))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%LP_RHS) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LP_RHS,1), UBOUND(OutData%LP_RHS,1) + OutData%LP_RHS(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LP_StifK_LU not allocated Int_Xferred = Int_Xferred + 1 @@ -11987,15 +12602,12 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LP_StifK_LU.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%LP_StifK_LU)>0) OutData%LP_StifK_LU = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%LP_StifK_LU))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%LP_StifK_LU) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%LP_StifK_LU,2), UBOUND(OutData%LP_StifK_LU,2) + DO i1 = LBOUND(OutData%LP_StifK_LU,1), UBOUND(OutData%LP_StifK_LU,1) + OutData%LP_StifK_LU(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LP_RHS_LU not allocated Int_Xferred = Int_Xferred + 1 @@ -12010,15 +12622,10 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LP_RHS_LU.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LP_RHS_LU)>0) OutData%LP_RHS_LU = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%LP_RHS_LU))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%LP_RHS_LU) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LP_RHS_LU,1), UBOUND(OutData%LP_RHS_LU,1) + OutData%LP_RHS_LU(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LP_indx not allocated Int_Xferred = Int_Xferred + 1 @@ -12033,15 +12640,10 @@ SUBROUTINE BD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LP_indx.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LP_indx)>0) OutData%LP_indx = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%LP_indx))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%LP_indx) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LP_indx,1), UBOUND(OutData%LP_indx,1) + OutData%LP_indx(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -12200,8 +12802,8 @@ SUBROUTINE BD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'BD_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -12216,6 +12818,8 @@ SUBROUTINE BD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(u1%RootMotion, u2%RootMotion, tin, u_out%RootMotion, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL MeshExtrapInterp1(u1%PointLoad, u2%PointLoad, tin, u_out%PointLoad, tin_out, ErrStat2, ErrMsg2 ) @@ -12253,8 +12857,9 @@ SUBROUTINE BD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'BD_Input_ExtrapInterp2' @@ -12276,6 +12881,8 @@ SUBROUTINE BD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(u1%RootMotion, u2%RootMotion, u3%RootMotion, tin, u_out%RootMotion, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL MeshExtrapInterp2(u1%PointLoad, u2%PointLoad, u3%PointLoad, tin, u_out%PointLoad, tin_out, ErrStat2, ErrMsg2 ) @@ -12361,12 +12968,12 @@ SUBROUTINE BD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'BD_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -12379,21 +12986,21 @@ SUBROUTINE BD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(y1%ReactionForce, y2%ReactionForce, tin, y_out%ReactionForce, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL MeshExtrapInterp1(y1%BldMotion, y2%BldMotion, tin, y_out%BldMotion, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - b0 = -(y1%RootMxr - y2%RootMxr)/t(2) - y_out%RootMxr = y1%RootMxr + b0 * t_out - b0 = -(y1%RootMyr - y2%RootMyr)/t(2) - y_out%RootMyr = y1%RootMyr + b0 * t_out + b = -(y1%RootMxr - y2%RootMxr) + y_out%RootMxr = y1%RootMxr + b * ScaleFactor + b = -(y1%RootMyr - y2%RootMyr) + y_out%RootMyr = y1%RootMyr + b * ScaleFactor IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = -(y1%WriteOutput - y2%WriteOutput)/t(2) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO END IF ! check if allocated END SUBROUTINE BD_Output_ExtrapInterp1 @@ -12424,13 +13031,14 @@ SUBROUTINE BD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'BD_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -12449,24 +13057,24 @@ SUBROUTINE BD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(y1%ReactionForce, y2%ReactionForce, y3%ReactionForce, tin, y_out%ReactionForce, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL MeshExtrapInterp2(y1%BldMotion, y2%BldMotion, y3%BldMotion, tin, y_out%BldMotion, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - b0 = (t(3)**2*(y1%RootMxr - y2%RootMxr) + t(2)**2*(-y1%RootMxr + y3%RootMxr))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%RootMxr + t(3)*y2%RootMxr - t(2)*y3%RootMxr ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%RootMxr = y1%RootMxr + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%RootMyr - y2%RootMyr) + t(2)**2*(-y1%RootMyr + y3%RootMyr))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%RootMyr + t(3)*y2%RootMyr - t(2)*y3%RootMyr ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%RootMyr = y1%RootMyr + b0 * t_out + c0 * t_out**2 + b = (t(3)**2*(y1%RootMxr - y2%RootMxr) + t(2)**2*(-y1%RootMxr + y3%RootMxr))* scaleFactor + c = ( (t(2)-t(3))*y1%RootMxr + t(3)*y2%RootMxr - t(2)*y3%RootMxr ) * scaleFactor + y_out%RootMxr = y1%RootMxr + b + c * t_out + b = (t(3)**2*(y1%RootMyr - y2%RootMyr) + t(2)**2*(-y1%RootMyr + y3%RootMyr))* scaleFactor + c = ( (t(2)-t(3))*y1%RootMyr + t(3)*y2%RootMyr - t(2)*y3%RootMyr ) * scaleFactor + y_out%RootMyr = y1%RootMyr + b + c * t_out IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = (t(3)**2*(y1%WriteOutput - y2%WriteOutput) + t(2)**2*(-y1%WriteOutput + y3%WriteOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WriteOutput + t(3)*y2%WriteOutput - t(2)*y3%WriteOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO END IF ! check if allocated END SUBROUTINE BD_Output_ExtrapInterp2 diff --git a/modules/beamdyn/src/Registry_BeamDyn.txt b/modules/beamdyn/src/Registry_BeamDyn.txt index 7858e60f3b..63feed3b38 100644 --- a/modules/beamdyn/src/Registry_BeamDyn.txt +++ b/modules/beamdyn/src/Registry_BeamDyn.txt @@ -109,6 +109,11 @@ typedef ^ BD_InputFile CHARACTER(ChanLen) OutList {:} - - "List typedef ^ BD_InputFile LOGICAL SumPrint - - - "Print summary data to file? (.sum)" - typedef ^ BD_InputFile CHARACTER(20) OutFmt - - - "Format specifier" - +# ..... BldNdOuts ............................................................................................ +typedef ^ BD_InputFile IntKi BldNd_NumOuts - - - "Number of requested output channels per blade node (BD_BldNdOuts)" - +typedef ^ BD_InputFile CHARACTER(ChanLen) BldNd_OutList {:} - - "List of user-requested output channels (BD_BldNdOuts)" - +typedef ^ BD_InputFile IntKi BldNd_BlOutNd {:} - - "The blade nodes to actually output (BD_BldNdOuts)" - +typedef ^ BD_InputFile CHARACTER(1024) BldNd_BlOutNd_Str - - - "String to parse for the blade nodes to actually output (BD_BldNdOuts)" - # ..... States @@ -210,6 +215,7 @@ typedef ^ ParameterType OutParmType OutParam {:} - - typedef ^ ParameterType IntKi NNodeOuts - - - "Number of nodes to output data to a file[0 - 9]" - typedef ^ ParameterType IntKi OutNd {9} - - "Nodes whose values will be output" - typedef ^ ParameterType IntKi NdIndx {:} - - "Index into BldMotion mesh (to number the nodes for output without using collocated nodes)" - +typedef ^ ParameterType IntKi NdIndxInverse {:} - - "Index from BldMotion mesh to unique nodes (to number the nodes for output without using collocated nodes)" - typedef ^ ParameterType IntKi OutNd2NdElem {:}{:} - - "To go from an output node number to a node/elem pair" - typedef ^ ParameterType CHARACTER(20) OutFmt - - - "Format specifier" - typedef ^ ParameterType Logical UsePitchAct - - - "Whether to use a pitch actuator inside BeamDyn" (flag) @@ -224,6 +230,11 @@ typedef ^ ParameterType Logical tngt_stf_fd - - - typedef ^ ParameterType Logical tngt_stf_comp - - - "Flag to compare finite differenced and analytical tangent stifness" - typedef ^ ParameterType R8Ki tngt_stf_pert - - - "Perturbation size for computing finite differenced tangent stiffness" - typedef ^ ParameterType R8Ki tngt_stf_difftol - - - "When comparing tangent stiffness matrix, stop simulation if error greater than this" - +# .... BD_BlNdOuts ........................................................................................................ +typedef ^ ParameterType IntKi BldNd_NumOuts - - - "[BD_BldNdOuts] Number of requested output channels per blade node" - +typedef ^ ParameterType IntKi BldNd_TotNumOuts - - - "[BD_BldNdOuts] Total number of requested output channels of blade node information (equal to BldNd_NumOuts * BldNd_BlOutNd)" - +typedef ^ ParameterType OutParmType BldNd_OutParam {:} - - "[BD_BldNdOuts] Names and units (and other characteristics) of all requested output parameters" - +typedef ^ ParameterType IntKi BldNd_BlOutNd {:} - - "[BD_BldNdOuts] The blade nodes to actually output" - # .... arrays for optimization ........................................................................................................ typedef ^ ParameterType R8Ki QPtw_Shp_Shp_Jac {:}{:}{:}{:} - - "optimization variable: QPtw_Shp_Shp_Jac(idx_qp,i,j,nelem) = p%Shp(i,idx_qp)*p%Shp(j,idx_qp)*p%QPtWeight(idx_qp)*p%Jacobian(idx_qp,nelem)" - typedef ^ ParameterType ^ QPtw_Shp_ShpDer {:}{:}{:} - - "optimization variable: QPtw_Shp_ShpDer(idx_qp,i,j) = p%Shp(i,idx_qp)*p%ShpDer(j,idx_qp)*p%QPtWeight(idx_qp)" - diff --git a/modules/elastodyn/CMakeLists.txt b/modules/elastodyn/CMakeLists.txt index 8571acf72b..5610748e9c 100644 --- a/modules/elastodyn/CMakeLists.txt +++ b/modules/elastodyn/CMakeLists.txt @@ -21,6 +21,7 @@ endif() set(ED_SOURCES src/ElastoDyn.f90 src/ElastoDyn_IO.f90 + src/ElastoDyn_AllBldNdOuts_IO.f90 src/ED_UserSubs.f90 src/ElastoDyn_Types.f90 ) diff --git a/modules/elastodyn/src/ElastoDyn.f90 b/modules/elastodyn/src/ElastoDyn.f90 index bd558f6d1c..2e0c2814e2 100644 --- a/modules/elastodyn/src/ElastoDyn.f90 +++ b/modules/elastodyn/src/ElastoDyn.f90 @@ -28,6 +28,8 @@ MODULE ElastoDyn USE ED_UserSubs ! <- module not in the FAST Framework! + USE ElastoDyn_AllBldNdOuts_IO + IMPLICIT NONE PRIVATE @@ -95,7 +97,7 @@ SUBROUTINE ED_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut TYPE(ED_InputFile) :: InputFileData ! Data stored in the module's input file INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation - INTEGER(IntKi) :: i, K ! loop counters + INTEGER(IntKi) :: i ! loop counters LOGICAL, PARAMETER :: GetAdamsVals = .FALSE. ! Determines if we should read Adams values and create (update) an Adams model CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None @@ -214,10 +216,11 @@ SUBROUTINE ED_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut !............................................................................................ ! Define initialization-routine output here: !............................................................................................ - CALL AllocAry( InitOut%WriteOutputHdr, p%NumOuts, 'WriteOutputHdr', ErrStat2, ErrMsg2 ) + CALL AllocAry( InitOut%WriteOutputHdr, p%numOuts + p%BldNd_TotNumOuts, 'WriteOutputHdr', errStat2, errMsg2 ) CALL CheckError( ErrStat2, ErrMsg2 ) IF (ErrStat >= AbortErrLev) RETURN - CALL AllocAry( InitOut%WriteOutputUnt, p%NumOuts, 'WriteOutputUnt', ErrStat2, ErrMsg2 ) + + CALL AllocAry( InitOut%WriteOutputUnt, p%numOuts + p%BldNd_TotNumOuts, 'WriteOutputUnt', errStat2, errMsg2 ) CALL CheckError( ErrStat2, ErrMsg2 ) IF (ErrStat >= AbortErrLev) RETURN @@ -225,6 +228,11 @@ SUBROUTINE ED_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut InitOut%WriteOutputHdr(i) = p%OutParam(i)%Name InitOut%WriteOutputUnt(i) = p%OutParam(i)%Units end do + + ! Set the info in WriteOutputHdr and WriteOutputUnt + CALL AllBldNdOuts_InitOut( InitOut, p, ErrStat2, ErrMsg2 ) + CALL CheckError( ErrStat2, ErrMsg2 ) + IF (ErrStat >= AbortErrLev) RETURN InitOut%Ver = ED_Ver InitOut%NumBl = p%NumBl @@ -236,6 +244,9 @@ SUBROUTINE ED_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitOut InitOut%HubHt = p%HubHt InitOut%TwrBasePos = y%TowerLn2Mesh%Position(:,p%TwrNodes + 2) InitOut%HubRad = p%HubRad + InitOut%RotSpeed = p%RotSpeed + InitOut%isFixed_GenDOF = .not. InputFileData%GenDOF + if (.not. p%BD4Blades) then ALLOCATE(InitOut%BldRNodes(p%BldNodes), STAT=ErrStat2) @@ -1291,7 +1302,15 @@ SUBROUTINE ED_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) ENDDO ! I - All selected output channels - + IF ( .NOT. p%BD4Blades ) THEN + y%WriteOutput(p%NumOuts+1:) = 0.0_ReKi + + ! Now we need to populate the blade node outputs here + call Calc_WriteAllBldNdOutput( p, u, m, y, LinAccES, ErrStat2, ErrMsg2 ) ! Call after normal writeoutput. Will just postpend data on here. + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'ED_CalcOutput') + ENDIF + + !............................................................................................................................... ! Outputs required for AeroDyn !............................................................................................................................... @@ -2015,8 +2034,12 @@ SUBROUTINE ED_SetParameters( InputFileData, p, ErrStat, ErrMsg ) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN + CALL AllBldNdOuts_SetParameters( p, InputFileData, ErrStat2, ErrMsg2 ) + CALL CheckError( ErrStat2, ErrMsg2 ) + IF ( ErrStat >= AbortErrLev ) RETURN + !p%BldNd_NumOuts = 0_IntKi + !p%BldNd_TotNumOuts = 0_IntKi - CONTAINS !............................................................................................................................... SUBROUTINE CheckError(ErrID,Msg) @@ -2073,7 +2096,7 @@ SUBROUTINE Init_DOFparameters( InputFileData, p, ErrStat, ErrMsg ) IF ( p%NumBl == 2 ) THEN p%NDOF = 22 ELSE - p%NDOF = 24 + p%NDOF = ED_MaxDOFs ENDIF p%NAug = p%NDOF + 1 @@ -8535,6 +8558,7 @@ END SUBROUTINE FillAugMat !> This routine allocates the arrays and meshes stored in the ED_OutputType data structure (y), based on the parameters (p). !! Inputs (u) are included only so that output meshes can be siblings of the inputs. !! The routine assumes that the arrays/meshes are not currently allocated (It will produce a fatal error otherwise.) +!! Also note that this must be called after init_u() so that the misc variables that contain the orientations are set. SUBROUTINE ED_AllocOutput( p, m, u, y, ErrStat, ErrMsg ) !.................................................................................................................................. @@ -8561,7 +8585,7 @@ SUBROUTINE ED_AllocOutput( p, m, u, y, ErrStat, ErrMsg ) ErrMsg = "" - CALL AllocAry( y%WriteOutput, p%NumOuts, 'WriteOutput', ErrStat2, ErrMsg2 ) + CALL AllocAry( y%WriteOutput, p%numOuts + p%BldNd_TotNumOuts, 'WriteOutput', errStat2, errMsg2 ) CALL CheckError( ErrStat2, ErrMsg2 ) IF (ErrStat >= AbortErrLev) RETURN @@ -8610,7 +8634,7 @@ SUBROUTINE ED_AllocOutput( p, m, u, y, ErrStat, ErrMsg ) IF (ErrStat >= AbortErrLev) RETURN ! Use orientation at node 1 for the blade root - CALL MeshPositionNode ( y%BladeLn2Mesh(K), p%BldNodes + 2, (/0.0_ReKi, 0.0_ReKi, 0.0_ReKi /), ErrStat2, ErrMsg2, Orient=u%BladePtLoads(K)%RefOrientation(:,:,1) ) + CALL MeshPositionNode ( y%BladeLn2Mesh(K), p%BldNodes + 2, (/0.0_ReKi, 0.0_ReKi, 0.0_ReKi /), ErrStat2, ErrMsg2, Orient=u%BladePtLoads(K)%RefOrientation(:,:,1), ref=.true. ) CALL CheckError( ErrStat2, ErrMsg2 ) IF (ErrStat >= AbortErrLev) RETURN @@ -8620,6 +8644,7 @@ SUBROUTINE ED_AllocOutput( p, m, u, y, ErrStat, ErrMsg ) DO J = 0,p%TipNode,p%TipNode if (j==0) then ! blade root NodeNum = p%BldNodes + 2 + y%BladeLn2Mesh(K)%RefNode = NodeNum elseif (j==p%TipNode) then ! blade tip NodeNum = p%BldNodes + 1 end if @@ -8737,7 +8762,7 @@ SUBROUTINE ED_AllocOutput( p, m, u, y, ErrStat, ErrMsg ) CALL CheckError(ErrStat2,ErrMsg2) IF (ErrStat >= AbortErrLev) RETURN - CALL MeshPositionNode ( y%TowerLn2Mesh, p%TwrNodes + 2, (/0.0_ReKi, 0.0_ReKi, p%TowerBsHt /), ErrStat2, ErrMsg2 ) + CALL MeshPositionNode ( y%TowerLn2Mesh, p%TwrNodes + 2, (/0.0_ReKi, 0.0_ReKi, p%TowerBsHt /), ErrStat2, ErrMsg2, ref=.true. ) CALL CheckError(ErrStat2,ErrMsg2) IF (ErrStat >= AbortErrLev) RETURN @@ -10232,6 +10257,19 @@ SUBROUTINE ED_PrintSum( p, OtherState, GenerateAdamsModel, ErrStat, ErrMsg ) WRITE (UnSu,OutPFmt) I, p%OutParam(I)%Name, p%OutParam(I)%Units END DO + IF (.not. p%BD4Blades) THEN + WRITE (UnSu,'(2x,A)') + WRITE (UnSu,'(2x,A)') + WRITE (UnSu,'(2x,A)') 'Requested Output Channels at each blade station:' + WRITE (UnSu,OutPFmtS) "Col", TitleStr + WRITE (UnSu,OutPFmtS) "---", TitleStrLines + !WRITE (UnSu,'(2x,A)') 'Col Parameter Units' + !WRITE (UnSu,'(2x,A)') '---- -------------- ----------' + DO I = 1,p%BldNd_NumOuts + WRITE (UnSu,OutPFmt) I, p%BldNd_OutParam(I)%Name, p%BldNd_OutParam(I)%Units + END DO + ENDIF + CLOSE(UnSu) RETURN @@ -11057,7 +11095,7 @@ SUBROUTINE ED_Init_Jacobian_y( p, y, InitOut, ErrStat, ErrMsg) + y%HubPtMotion%NNodes * 9 & ! 3 TranslationDisp, Orientation, and RotationVel at each node + y%NacelleMotion%NNodes * 18 & ! 3 TranslationDisp, Orientation, TranslationVel, RotationVel, TranslationAcc, and RotationAcc at each node + 3 & ! Yaw, YawRate, and HSS_Spd - + p%NumOuts ! WriteOutput values + + p%NumOuts + p%BldNd_TotNumOuts ! WriteOutput values do i=1,p%NumBl p%Jac_ny = p%Jac_ny + y%BladeRootMotion(i)%NNodes * 18 ! 3 TranslationDisp, Orientation, TranslationVel, RotationVel, TranslationAcc, and RotationAcc at each (1) node on each blade @@ -11101,7 +11139,7 @@ SUBROUTINE ED_Init_Jacobian_y( p, y, InitOut, ErrStat, ErrMsg) InitOut%LinNames_y(index_next) = 'YawRate, rad/s'; index_next = index_next+1 InitOut%LinNames_y(index_next) = 'HSS_Spd, rad/s' - do i=1,p%NumOuts + do i=1,p%NumOuts + p%BldNd_TotNumOuts InitOut%LinNames_y(i+index_next) = trim(InitOut%WriteOutputHdr(i))//', '//trim(InitOut%WriteOutputUnt(i)) !trim(p%OutParam(i)%Name)//', '//p%OutParam(i)%Units end do @@ -11162,6 +11200,10 @@ SUBROUTINE ED_Init_Jacobian_y( p, y, InitOut, ErrStat, ErrMsg) InitOut%RotFrame_y(i+index_next) = AllOut( p%OutParam(i)%Indx ) end do + do i=1, p%BldNd_TotNumOuts + InitOut%RotFrame_y(i+p%NumOuts+index_next) = .true. + end do + deallocate(AllOut) @@ -11609,7 +11651,7 @@ SUBROUTINE Compute_dY(p, y_p, y_m, delta, dY) dY(indx_first) = y_p%HSS_Spd - y_m%HSS_Spd; indx_first = indx_first + 1 !indx_last = indx_first + p%NumOuts - 1 - do k=1,p%NumOuts + do k=1,p%NumOuts + p%BldNd_TotNumOuts dY(k+indx_first-1) = y_p%WriteOutput(k) - y_m%WriteOutput(k) end do @@ -11618,7 +11660,7 @@ SUBROUTINE Compute_dY(p, y_p, y_m, delta, dY) END SUBROUTINE Compute_dY !---------------------------------------------------------------------------------------------------------------------------------- !> Routine to pack the data structures representing the operating points into arrays for linearization. -SUBROUTINE ED_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op ) +SUBROUTINE ED_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, y_op, x_op, dx_op, xd_op, z_op, NeedLogMap ) REAL(DbKi), INTENT(IN ) :: t !< Time in seconds at operating point TYPE(ED_InputType), INTENT(IN ) :: u !< Inputs at operating point (may change to inout if a mesh copy is required) @@ -11637,6 +11679,7 @@ SUBROUTINE ED_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: dx_op(:) !< values of first time derivatives of linearized continuous states REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: xd_op(:) !< values of linearized discrete states REAL(ReKi), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: z_op(:) !< values of linearized constraint states + LOGICAL, OPTIONAL, INTENT(IN ) :: NeedLogMap !< whether a y_op values should contain log maps instead of full orientation matrices @@ -11645,6 +11688,7 @@ SUBROUTINE ED_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ED_GetOP' + LOGICAL :: ReturnLogMap TYPE(ED_ContinuousStateType) :: dx !< derivative of continuous states at operating point LOGICAL :: Mask(FIELDMASK_SIZE) !< flags to determine if this field is part of the packing @@ -11695,6 +11739,11 @@ SUBROUTINE ED_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, !.................................. IF ( PRESENT( y_op ) ) THEN + if (present(NeedLogMap)) then + ReturnLogMap = NeedLogMap + else + ReturnLogMap = .false. + end if if (.not. allocated(y_op)) then ! our operating point includes DCM (orientation) matrices, not just small angles like the perturbation matrices do @@ -11727,22 +11776,22 @@ SUBROUTINE ED_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_op, index = 1 if (allocated(y%BladeLn2Mesh)) then do k=1,p%NumBl - call PackMotionMesh(y%BladeLn2Mesh(k), y_op, index) + call PackMotionMesh(y%BladeLn2Mesh(k), y_op, index, UseLogMaps=ReturnLogMap) end do end if - call PackMotionMesh(y%PlatformPtMesh, y_op, index) - call PackMotionMesh(y%TowerLn2Mesh, y_op, index) - call PackMotionMesh(y%HubPtMotion, y_op, index, FieldMask=Mask) + call PackMotionMesh(y%PlatformPtMesh, y_op, index, UseLogMaps=ReturnLogMap) + call PackMotionMesh(y%TowerLn2Mesh, y_op, index, UseLogMaps=ReturnLogMap) + call PackMotionMesh(y%HubPtMotion, y_op, index, FieldMask=Mask, UseLogMaps=ReturnLogMap) do k=1,p%NumBl - call PackMotionMesh(y%BladeRootMotion(k), y_op, index) + call PackMotionMesh(y%BladeRootMotion(k), y_op, index, UseLogMaps=ReturnLogMap) end do - call PackMotionMesh(y%NacelleMotion, y_op, index) + call PackMotionMesh(y%NacelleMotion, y_op, index, UseLogMaps=ReturnLogMap) y_op(index) = y%Yaw ; index = index + 1 y_op(index) = y%YawRate ; index = index + 1 y_op(index) = y%HSS_Spd - do i=1,p%NumOuts + do i=1,p%NumOuts + p%BldNd_TotNumOuts y_op(i+index) = y%WriteOutput(i) end do diff --git a/modules/elastodyn/src/ElastoDyn_AllBldNdOuts_IO.f90 b/modules/elastodyn/src/ElastoDyn_AllBldNdOuts_IO.f90 new file mode 100644 index 0000000000..3c668bd57e --- /dev/null +++ b/modules/elastodyn/src/ElastoDyn_AllBldNdOuts_IO.f90 @@ -0,0 +1,664 @@ +! This module is an add on to ElastoDyn to allow output of blade structural data at each blade node when BeamDyn is not used +! +! Copyright 2016 Envision Energy +! + +MODULE ElastoDyn_AllBldNdOuts_IO + + USE NWTC_Library + USE ElastoDyn_Types + + IMPLICIT NONE + + PRIVATE + + + PUBLIC :: AllBldNdOuts_InitOut + PUBLIC :: Calc_WriteAllBldNdOutput + PUBLIC :: AllBldNdOuts_SetParameters + + + ! Parameters related to output length (number of characters allowed in the output data headers): + + INTEGER(IntKi), PARAMETER :: OutStrLenM1 = ChanLen-6 ! The NREL allowed channel name length is usually 20. We are making these of the form B#N###namesuffix + + +! =================================================================================================== +! NOTE: The following lines of code were generated by a Matlab script called "Write_ChckOutLst.m" +! using the parameters listed in the "OutListParameters.xlsx" Excel file. Any changes to these +! lines should be modified in the Matlab script and/or Excel worksheet as necessary. +! =================================================================================================== +! This code was generated by Write_ChckOutLst.m at 14-Dec-2017 10:34:30. + + + ! Indices for computing output channels: + ! NOTES: + ! (1) These parameters are in the order stored in "OutListParameters.xlsx" + ! (2) Array AllOuts() must be dimensioned to the value of the largest output parameter + + + ! Local Span Motions: + + INTEGER(IntKi), PARAMETER :: BldNd_ALx = 1 + INTEGER(IntKi), PARAMETER :: BldNd_ALy = 2 + INTEGER(IntKi), PARAMETER :: BldNd_ALz = 3 + INTEGER(IntKi), PARAMETER :: BldNd_TDx = 4 + INTEGER(IntKi), PARAMETER :: BldNd_TDy = 5 + INTEGER(IntKi), PARAMETER :: BldNd_TDz = 6 + INTEGER(IntKi), PARAMETER :: BldNd_RDx = 7 + INTEGER(IntKi), PARAMETER :: BldNd_RDy = 8 + INTEGER(IntKi), PARAMETER :: BldNd_RDz = 9 + + + ! Local Span Loads: + + INTEGER(IntKi), PARAMETER :: BldNd_MLx = 10 + INTEGER(IntKi), PARAMETER :: BldNd_MLy = 11 + INTEGER(IntKi), PARAMETER :: BldNd_MLz = 12 + INTEGER(IntKi), PARAMETER :: BldNd_FLx = 13 + INTEGER(IntKi), PARAMETER :: BldNd_FLy = 14 + INTEGER(IntKi), PARAMETER :: BldNd_FLz = 15 + INTEGER(IntKi), PARAMETER :: BldNd_MLxNT = 16 + INTEGER(IntKi), PARAMETER :: BldNd_MlyNT = 17 + INTEGER(IntKi), PARAMETER :: BldNd_FLxNT = 18 + INTEGER(IntKi), PARAMETER :: BldNd_FlyNT = 19 + + + ! The maximum number of output channels which can be output by the code. + INTEGER(IntKi), PARAMETER, PUBLIC :: BldNd_MaxOutPts = 19 + +!End of code generated by Matlab script +! =================================================================================================== + + +CONTAINS +!---------------------------------------------------------------------------------------------------------------------------------- + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This subroutine populates the headers with the blade node outputs. The iteration cycle is blade:node:channel (channel iterated +!! fastest). If this iteration order is changed, it should be changed in the Calc_WriteAllBldNdOutput routine as well. +SUBROUTINE AllBldNdOuts_InitOut( InitOut, p, ErrStat, ErrMsg ) + + + TYPE(ED_InitOutputType), INTENT(INOUT) :: InitOut ! output data + TYPE(ED_ParameterType), INTENT(IN ) :: p ! The module parameters + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! The error status code + CHARACTER(*), INTENT( OUT) :: ErrMsg ! The error message, if an error occurred + + INTEGER(IntKi) :: INDX ! Index count within WriteOutput + INTEGER(IntKi) :: IdxBlade ! Counter to which blade we are on + INTEGER(IntKi) :: IdxNode ! Counter to the blade node we ae on + INTEGER(IntKi) :: IdxChan ! Counter to the channel we are outputting. + CHARACTER(62) :: ChanPrefix ! Name prefix (B#N###) + CHARACTER(6) :: TmpChar ! Temporary char array to hold the node digits (3 places only!!!!) + CHARACTER(*), PARAMETER :: RoutineName = ('AllBldNdOuts_InitOut') + + + ! Initialize some things + ErrMsg = '' + ErrStat = ErrID_None + + ! First set a counter so we know where in the output array we are in + INDX = p%NumOuts + 1 ! p%NumOuts is the number of outputs from the normal ElastoDyn output. The WriteOutput array is sized to p%NumOuts + num(AllBldNdOuts) + + ! Populate the header and unit lines for all blades and nodes +#ifndef OUTPUT_CHANNEL_NAMES_AS_DISTANCE + ! ! Warn if we will run into issues with more than 999 nodes. + IF (p%BldNodes > 999 ) CALL SetErrStat(ErrID_Severe,'More than 999 blade nodes in use. Output channel headers will not '// & + 'correctly reflect blade stations beyond 999. Modifications to the variable ChanLen in FAST are required.',ErrStat,ErrMsg,RoutineName) + + ! Populate the header an unit lines for all blades and nodes + ! Loop through all the outputs we requested here: + DO IdxChan=1,p%BldNd_NumOuts + + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + + ! 3 digit node number + WRITE (TmpChar,'(I3.3)') IdxNode + ChanPrefix = 'B' // TRIM(Num2LStr(IdxBlade)) // 'N' // TRIM(TmpChar) + + ! Now write to the header + InitOut%WriteOutputHdr(INDX) = TRIM(ChanPrefix) // TRIM(p%BldNd_OutParam(IdxChan)%Name) + InitOut%WriteOutputUnt(INDX) = p%BldNd_OutParam(IdxChan)%Units + + ! Increment the index to the Header arrays + INDX = INDX + 1 + ENDDO + + END DO + END DO + +#else + ! output format the name of the channel with the distance in cm from the root of the blade instead of by node number. + + ! Loop through all the outputs we requested here: + DO IdxChan=1,p%BldNd_NumOuts + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + + ! Node defined by distance along blade + WRITE (TmpChar,'(I6.6)') NINT( 1000.0_ReKi * p%RNodes( IdxNode ) ) + ChanPrefix = 'B' // TRIM(Num2LStr(IdxBlade)) // '_Z' // TRIM(TmpChar) //'_' + + + ! Now write to the header + InitOut%WriteOutputHdr(INDX) = TRIM(ChanPrefix) // TRIM(p%BldNd_OutParam(IdxChan)%Name) + InitOut%WriteOutputUnt(INDX) = p%BldNd_OutParam(IdxChan)%Units + + ! Increment the index to the Header arrays + INDX = INDX + 1 + ENDDO + + ENDDO + ENDDO + +#endif + + +END SUBROUTINE AllBldNdOuts_InitOut + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This subroutine populates the headers with the blade node outputs. The iteration cycle is blade:node:channel (channel iterated +!! fastest). If this iteration order is changed, it should be changed in the Calc_WriteAllBldNdOutput routine as well. +SUBROUTINE Calc_WriteAllBldNdOutput( p, u, m, y, LinAccES, ErrStat, ErrMsg ) + TYPE(ED_ParameterType), INTENT(IN ) :: p ! The module parameters + TYPE(ED_InputType), INTENT(IN ) :: u ! inputs + TYPE(ED_MiscVarType), INTENT(INOUT) :: m ! misc variables + TYPE(ED_OutputType), INTENT(INOUT) :: y ! outputs + REAL(ReKi), INTENT(IN ) :: LinAccES(:,0:,:) ! Total linear acceleration of a point on a blade (point S) in the inertia frame (body E for earth). NOTE: zero index start. + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! The error status code + CHARACTER(*), INTENT( OUT) :: ErrMsg ! The error message, if an error occurred + + ! local variables + + INTEGER(IntKi) :: OutIdx ! Index count within WriteOutput + INTEGER(IntKi) :: IdxBlade ! Counter to which blade we are on + INTEGER(IntKi) :: IdxNode ! Counter to the blade node we ae on + INTEGER(IntKi) :: J ! Generic counter for moment and force summation + INTEGER(IntKi) :: IdxChan ! Counter to the channel we are outputting. + CHARACTER(5) :: ChanPrefix ! Name prefix ( B#N### or B#D#### ) + CHARACTER(2) :: TmpChar ! Temporary char array to hold the node digits (2 places only!!!!) + CHARACTER(*), PARAMETER :: RoutineName = 'Calc_WriteAllBldNdOutput' +! REAL(ReKi) :: ct, st ! cosine, sine of theta +! REAL(ReKi) :: cp, sp ! cosine, sine of phi +! REAL(ReKi) :: Tmp(3) + REAL(ReKi) :: OutVal ! Temporary variable to hold the value to output to the channel. + + ! Variables used in the CalcOutput routine that are needed here for coordinate transforms + REAL(R8Ki) :: rSPS (3) ! Position vector from the undeflected blade node (point S prime) to the deflected node (point S) + REAL(R8Ki) :: TmpVec (3) ! A temporary vector used in various computations. + REAL(R8Ki) :: TmpVec2 (3) ! A temporary vector. + + + ! Initialize some things + ErrMsg = '' + ErrStat = ErrID_None + + + ! Populate the header an unit lines for all blades and nodes + ! First set a counter so we know where in the output array we are in + OutIdx = p%NumOuts + 1 ! p%NumOuts is the number of outputs from the normal ElastoDyn output. The WriteOutput array is sized to p%NumOuts + num(AllBldNdOuts) + + ! Loop through all the outputs we requested here: + DO IdxChan=1,p%BldNd_NumOuts + + SELECT CASE( p%BldNd_OutParam(IdxChan)%Indx ) ! Indx contains the information on what channel should be output + CASE (0) ! Invalid channel + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + y%WriteOutput( OutIdx ) = 0.0_ReKi + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_ALx ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + y%WriteOutput( OutIdx ) = DOT_PRODUCT( LinAccES(:,IdxNode,IdxBlade), m%CoordSys%n1(IdxBlade,IdxNode,:) ) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_ALy ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + y%WriteOutput( OutIdx ) = DOT_PRODUCT( LinAccES(:,IdxNode,IdxBlade), m%CoordSys%n2(IdxBlade,IdxNode,:) ) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_ALz ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + y%WriteOutput( OutIdx ) = DOT_PRODUCT( LinAccES(:,IdxNode,IdxBlade), m%CoordSys%n3(IdxBlade,IdxNode,:) ) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_TDx ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + rSPS = m%RtHS%rS0S(:,IdxBlade,IdxNode) - p%RNodes(IdxNode)*m%CoordSys%j3(IdxBlade,:) + y%WriteOutput( OutIdx ) = DOT_PRODUCT( rSPS, m%CoordSys%j1(IdxBlade,:) ) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_TDy ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + rSPS = m%RtHS%rS0S(:,IdxBlade,IdxNode) - p%RNodes(IdxNode)*m%CoordSys%j3(IdxBlade,:) + y%WriteOutput( OutIdx ) = DOT_PRODUCT( rSPS, m%CoordSys%j2(IdxBlade,:) ) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_TDz ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + rSPS = m%RtHS%rS0S(:,IdxBlade,IdxNode) - p%RNodes(IdxNode)*m%CoordSys%j3(IdxBlade,:) + y%WriteOutput( OutIdx ) = DOT_PRODUCT( rSPS, m%CoordSys%j3(IdxBlade,:) ) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_RDx ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + y%WriteOutput( OutIdx ) = DOT_PRODUCT( m%RtHS%AngPosHM(:,IdxBlade,IdxNode), m%CoordSys%j1(IdxBlade,:) )*R2D + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_RDy ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + y%WriteOutput( OutIdx ) = DOT_PRODUCT( m%RtHS%AngPosHM(:,IdxBlade,IdxNode), m%CoordSys%j2(IdxBlade,:) )*R2D + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_RDz ) ! See note in ElastoDyn.f90 + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + ! y%WriteOutput( OutIdx ) = DOT_PRODUCT( m%RtHS%AngPosHM(:,IdxBlade,IdxNode), m%CoordSys%j3(IdxBlade,:) )*R2D ! this is always zero for FAST + y%WriteOutput( OutIdx ) = 0.0_Reki + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_FLx ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + y%WriteOutput( OutIdx ) = DOT_PRODUCT( FrcMGagB(), m%CoordSys%n1(IdxBlade,IdxNode,:) ) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_FLy ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + y%WriteOutput( OutIdx ) = DOT_PRODUCT( FrcMGagB(), m%CoordSys%n2(IdxBlade,IdxNode,:) ) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_FLz ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + y%WriteOutput( OutIdx ) = DOT_PRODUCT( FrcMGagB(), m%CoordSys%n3(IdxBlade,IdxNode,:) ) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_MLx ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + y%WriteOutput( OutIdx ) = DOT_PRODUCT( MomMGagB(), m%CoordSys%n1(IdxBlade,IdxNode,:) ) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_MLy ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + y%WriteOutput( OutIdx ) = DOT_PRODUCT( MomMGagB(), m%CoordSys%n2(IdxBlade,IdxNode,:) ) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_MLz ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + y%WriteOutput( OutIdx ) = DOT_PRODUCT( MomMGagB(), m%CoordSys%n3(IdxBlade,IdxNode,:) ) + OutIdx = OutIdx + 1 + END DO + END DO + + ! Output blade loads in the blade coordinate system. + CASE ( BldNd_FLxNT ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + y%WriteOutput( OutIdx ) = DOT_PRODUCT( FrcMGagB(), CoordSysNT1() ) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_FLyNT ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + y%WriteOutput( OutIdx ) = DOT_PRODUCT( FrcMGagB(), CoordSysNT2() ) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_MLxNT ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + y%WriteOutput( OutIdx ) = DOT_PRODUCT( MomMGagB(), CoordSysNT1() ) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE ( BldNd_MLyNT ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + y%WriteOutput( OutIdx ) = DOT_PRODUCT( MomMGagB(), CoordSysNT2() ) + OutIdx = OutIdx + 1 + END DO + END DO + + CASE DEFAULT + CALL SetErrStat( ErrID_Severe, "Coding error. Output channel not properly set.",ErrStat,ErrMsg,RoutineName ) + DO IdxBlade=1,p%BldNd_BladesOut + DO IdxNode=1,p%BldNodes + y%WriteOutput( OutIdx ) = 0.0_ReKi + OutIdx = OutIdx + 1 + END DO + END DO + + END SELECT + END DO + +contains +function CoordSysNT1() + REAL(ReKi) :: CoordSysNT1 (3) ! A temporary matrix for removing the structural twist from the local output forces and moments, dimension 1 + ! removed + CoordSysNT1(:) = p%CThetaS(IdxBlade,IdxNode)*m%CoordSys%n1(IdxBlade,IdxNode,:) + p%SThetaS(IdxBlade,IdxNode)*m%CoordSys%n2(IdxBlade,IdxNode,:) + +end function CoordSysNT1 + +function CoordSysNT2() + REAL(ReKi) :: CoordSysNT2 (3) ! A temporary matrix for removing the structural twist from the local output forces and moments, dimension 2 + + CoordSysNT2(:) = -p%SThetaS(IdxBlade,IdxNode)*m%CoordSys%n1(IdxBlade,IdxNode,:) + p%CThetaS(IdxBlade,IdxNode)*m%CoordSys%n2(IdxBlade,IdxNode,:) + +end function CoordSysNT2 + + +function FrcMGagB() + REAL(R8Ki) :: FrcMGagB (3) ! Total force at the blade element (body M) / blade strain gage location (point S) due to the blade above the strain gage. + + ! Initialize FrcMGagB using the tip brake effects: + + FrcMGagB = m%RtHS%FSTipDrag(:,IdxBlade) - p%TipMass(IdxBlade)*( p%Gravity*m%CoordSys%z2 + LinAccES(:,p%TipNode,IdxBlade) ) + + ! Integrate to find FrcMGagB and MomMGagB using all of the nodes / elements above the current strain gage location: + DO J = ( IdxNode + 1 ),p%BldNodes ! Loop through blade nodes / elements above strain gage node + + TmpVec2 = m%RtHS%FSAero(:,IdxBlade,J) - p%MassB(IdxBlade,J)*( p%Gravity*m%CoordSys%z2 + LinAccES(:,J,IdxBlade) ) ! Portion of FrcMGagB associated with element J + FrcMGagB = FrcMGagB + TmpVec2*p%DRNodes(J) + + ENDDO ! J - Blade nodes / elements above strain gage node + + ! Add the effects of 1/2 the strain gage element: + ! NOTE: for the radius in this calculation, assume that there is no + ! shortening effect (due to blade bending) within the element. Thus, + ! the moment arm for the force is 1/4 of p%DRNodes() and the element + ! length is 1/2 of p%DRNodes(). + + TmpVec2 = m%RtHS%FSAero(:,IdxBlade,IdxNode) - p%MassB(IdxBlade,IdxNode)* ( p%Gravity*m%CoordSys%z2 + LinAccES(:,IdxNode,IdxBlade) ) ! Portion of FrcMGagB associated with 1/2 of the strain gage element + FrcMGagB = FrcMGagB + TmpVec2 * 0.5 * p%DRNodes(IdxNode) ! Portion of FrcMGagB associated with 1/2 of the strain gage element + FrcMGagB = 0.001*FrcMGagB ! Convert the local force to kN + +end function FrcMGagB + +function MomMGagB() + REAL(ReKi) :: MomMGagB (3) ! Total moment at the blade element (body M) / blade strain gage location (point S) due to the blade above the strain gage. + + ! Initialize MomMGagB using the tip brake effects: + + TmpVec2 = m%RtHS%FSTipDrag(:,IdxBlade) - p%TipMass(IdxBlade)*( p%Gravity*m%CoordSys%z2 + LinAccES(:,p%TipNode,IdxBlade) ) ! Portion of FrcMGagB + MomMGagB = CROSS_PRODUCT( m%RtHS%rS0S(:,IdxBlade,p%TipNode) - m%RtHS%rS0S(:,IdxBlade,IdxNode), TmpVec2 ) + + ! Integrate to find FrcMGagB and MomMGagB using all of the nodes / elements above the current strain gage location: + DO J = ( IdxNode + 1 ),p%BldNodes ! Loop through blade nodes / elements above strain gage node + + TmpVec2 = m%RtHS%FSAero(:,IdxBlade,J) - p%MassB(IdxBlade,J)*( p%Gravity*m%CoordSys%z2 + LinAccES(:,J,IdxBlade) ) ! Portion of FrcMGagB associated with element J + TmpVec = CROSS_PRODUCT( m%RtHS%rS0S(:,IdxBlade,J) - m%RtHS%rS0S(:,IdxBlade,IdxNode), TmpVec2 ) ! Portion of MomMGagB associated with element J + MomMGagB = MomMGagB + ( TmpVec + m%RtHS%MMAero(:,IdxBlade,J) )*p%DRNodes(J) + + ENDDO ! J - Blade nodes / elements above strain gage node + + ! Add the effects of 1/2 the strain gage element: + ! NOTE: for the radius in this calculation, assume that there is no + ! shortening effect (due to blade bending) within the element. Thus, + ! the moment arm for the force is 1/4 of p%DRNodes() and the element + ! length is 1/2 of p%DRNodes(). + + TmpVec2 = m%RtHS%FSAero(:,IdxBlade,IdxNode) - p%MassB(IdxBlade,IdxNode)* ( p%Gravity*m%CoordSys%z2 + LinAccES(:,IdxNode,IdxBlade) ) ! Portion of FrcMGagB associated with 1/2 of the strain gage element + TmpVec = CROSS_PRODUCT( ( 0.25_R8Ki*p%DRNodes(IdxNode) )*m%CoordSys%j3(IdxBlade,:), TmpVec2 ) ! Portion of MomMGagB associated with 1/2 of the strain gage element + + MomMGagB = MomMGagB + ( TmpVec + m%RtHS%MMAero(:,IdxBlade,IdxNode) )* ( 0.5 *p%DRNodes(IdxNode) ) + MomMGagB = 0.001*MomMGagB ! Convert the local moment to kN-m + +end function MomMGagB + +END SUBROUTINE Calc_WriteAllBldNdOutput + + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine validates and sets the parameters for the nodal outputs. +SUBROUTINE AllBldNdOuts_SetParameters( p, InputFileData, ErrStat, ErrMsg ) +!.................................................................................................................................. + + + ! Passed variables: + + TYPE(ED_InputFile), INTENT(IN ) :: InputFileData !< Data stored in the module's input file + TYPE(ED_ParameterType), INTENT(INOUT) :: p !< Parameters + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + + ! local variables + integer(IntKi) :: k ! Blade number + integer(IntKi) :: j ! node number + character(*), parameter :: RoutineName = 'AllBldNdOuts_ValidateInputData' + + ErrStat = ErrID_None + ErrMsg = "" + + ! Check if the requested blades exist + IF ( (InputFileData%BldNd_BladesOut < 0_IntKi) .OR. (InputFileData%BldNd_BladesOut > p%NumBl) ) THEN + CALL SetErrStat( ErrID_Warn, " Number of blades to output data at all bladed nodes (BldNd_BladesOut) must be between 0 and "//TRIM(Num2LStr(p%NumBl))//".", ErrStat, ErrMsg, RoutineName) + p%BldNd_BladesOut = 0_IntKi + ELSE + p%BldNd_BladesOut = InputFileData%BldNd_BladesOut + ENDIF + + + ! Check if the requested blade nodes are valid + ! InputFileData%BldNd_BlOutNd + + + + ! Set the parameter to store number of requested Blade Node output sets + IF ( p%BD4Blades .and. InputFileData%BldNd_NumOuts > 0 ) THEN + p%BldNd_BladesOut = 0_IntKi + p%BldNd_NumOuts = 0_IntKi + CALL SetErrStat( ErrID_Warn,' AllBldNdOuts option not available in ElastoDyn when BeamDyn is used. Turning off these outputs.',ErrStat,ErrMsg,"SetPrimaryParameters" ) + ELSE + p%BldNd_NumOuts = InputFileData%BldNd_NumOuts + ENDIF + + ! Set the total number of outputs ( requested channel groups * number requested nodes * number requested blades ) + p%BldNd_TotNumOuts = p%BldNodes*p%BldNd_BladesOut*p%BldNd_NumOuts !p%BldNd_NumOuts * size(p%BldNd_BlOutNd) * size(p%BldNd_BladesOut) + +! ! Check if the blade node array to output is valid: p%BldNd_BlOutNd +! ! TODO: this value is not read in by the input file reading yet, so setting to all blade nodes +! ! -- check if list handed in is of nodes that exist (not sure this is ever checked) +! ! -- copy values over +! +! ! Temporary workaround here: +! ALLOCATE ( p%BldNd_BlOutNd(1:p%BldNodes) , STAT=ErrStat2 ) +! IF ( ErrStat2 /= 0_IntKi ) THEN +! CALL SetErrStat( ErrID_Fatal,"Error allocating memory for the ElastoDyn OutParam array.", ErrStat, ErrMsg, RoutineName ) +! RETURN +! ENDIF +! DO I=1,p%BldNodes ! put all nodes in the list +! p%BldNd_BlOutNd(i) = i +! ENDDO + + +! ! Check if the requested blades are actually in use: +! ! TODO: this value is not read in by the input file reading yet, so setting to all blades +! ! -- check if list handed in is of blades that exist (not sure this is ever checked) +! ! -- copy values over +! ALLOCATE ( p%BldNd_BladesOut(1:p%NumBl), STAT=ErrStat2 ) +! IF ( ErrStat2 /= 0_IntKi ) THEN +! CALL SetErrStat( ErrID_Fatal,"Error allocating memory for the ElastoDyn OutParam array.", ErrStat, ErrMsg, RoutineName ) +! RETURN +! ENDIF +! DO I=1,p%NumBl ! put all blades in the list +! p%BldNd_BladesOut(i) = i +! ENDDO + + if (p%BldNd_TotNumOuts > 0) then + call BldNdOuts_SetOutParam(InputFileData%BldNd_OutList, p, ErrStat, ErrMsg ) + if (ErrStat >= AbortErrLev) return + end if + + +END SUBROUTINE AllBldNdOuts_SetParameters + + +!********************************************************************************************************************************** +! NOTE: The following lines of code were generated by a Matlab script called "Write_ChckOutLst.m" +! using the parameters listed in the "OutListParameters.xlsx" Excel file. Any changes to these +! lines should be modified in the Matlab script and/or Excel worksheet as necessary. +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine checks to see if any requested output channel names (stored in the OutList(:)) are invalid. It returns a +!! warning if any of the channels are not available outputs from the module. +!! It assigns the settings for OutParam(:) (i.e, the index, name, and units of the output channels, WriteOutput(:)). +!! the sign is set to 0 if the channel is invalid. +!! It sets assumes the value p%NumOuts has been set before this routine has been called, and it sets the values of p%OutParam here. +!! +!! This routine was generated by Write_ChckOutLst.m using the parameters listed in OutListParameters.xlsx at 14-Dec-2017 10:34:30. +SUBROUTINE BldNdOuts_SetOutParam(BldNd_OutList, p, ErrStat, ErrMsg ) +!.................................................................................................................................. + + IMPLICIT NONE + + ! Passed variables + + CHARACTER(ChanLen), INTENT(IN) :: BldNd_OutList(:) !< The list out user-requested outputs + TYPE(ED_ParameterType), INTENT(INOUT) :: p !< The module parameters + INTEGER(IntKi), INTENT(OUT) :: ErrStat !< The error status code + CHARACTER(*), INTENT(OUT) :: ErrMsg !< The error message, if an error occurred + + ! Local variables + + INTEGER :: ErrStat2 ! temporary (local) error status + INTEGER :: I ! Generic loop-counting index + INTEGER :: J ! Generic loop-counting index + INTEGER :: INDX ! Index for valid arrays + + LOGICAL :: InvalidOutput(1:BldNd_MaxOutPts) ! This array determines if the output channel is valid for this configuration + CHARACTER(ChanLen) :: OutListTmp ! A string to temporarily hold OutList(I) + CHARACTER(*), PARAMETER :: RoutineName = "BldNdOuts_SetOutParam" + + CHARACTER(OutStrLenM1), PARAMETER :: ValidParamAry(42) = (/ & ! This lists the names of the allowed parameters, which must be sorted alphabetically + "ALX ","ALY ","ALZ ","AX ","AY ","AZ ","FLX ","FLXNT","FLY ","FLYNT", & + "FLZ ","FLZNT","FX ","FXL ","FY ","FYL ","FZ ","FZL ","MLX ","MLXNT", & + "MLY ","MLYNT","MLZ ","MLZNT","MX ","MXL ","MY ","MYL ","MZ ","MZL ", & + "RDX ","RDY ","RDZ ","RX ","RY ","RZ ","TDX ","TDY ","TDZ ","UXB ", & + "UYB ","UZB "/) + INTEGER(IntKi), PARAMETER :: ParamIndxAry(42) = (/ & ! This lists the index into AllOuts(:) of the allowed parameters ValidParamAry(:) + BldNd_ALx , BldNd_ALy , BldNd_ALz , BldNd_ALx , BldNd_ALy , BldNd_ALz , BldNd_FLx , BldNd_FLxNT , BldNd_FLy , BldNd_FlyNT , & + BldNd_FLz , BldNd_FLz , BldNd_FLx , BldNd_FLxNT , BldNd_FLy , BldNd_FlyNT , BldNd_FLz , BldNd_FLz , BldNd_MLx , BldNd_MLxNT , & + BldNd_MLy , BldNd_MlyNT , BldNd_MLz , BldNd_MLz , BldNd_MLx , BldNd_MLxNT , BldNd_MLy , BldNd_MlyNT , BldNd_MLz , BldNd_MLz , & + BldNd_RDx , BldNd_RDy , BldNd_RDz , BldNd_RDx , BldNd_RDy , BldNd_RDz , BldNd_TDx , BldNd_TDy , BldNd_TDz , BldNd_TDx , & + BldNd_TDy , BldNd_TDz /) + CHARACTER(ChanLen), PARAMETER :: ParamUnitsAry(42) = (/ & ! This lists the units corresponding to the allowed parameters + "(m/s^2)","(m/s^2)","(m/s^2)","(m/s^2)","(m/s^2)","(m/s^2)","(kN) ","(kN) ","(kN) ","(kN) ", & + "(kN) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN) ","(kN-m) ","(kN-m) ", & + "(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ","(kN-m) ", & + "(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(deg) ","(m) ","(m) ","(m) ","(m) ", & + "(m) ","(m) "/) + + + ! Initialize values + ErrStat = ErrID_None + ErrMsg = "" + InvalidOutput = .FALSE. + + +! ..... Developer must add checking for invalid inputs here: ..... + +! ................. End of validity checking ................. + + + !------------------------------------------------------------------------------------------------- + ! Allocate and set index, name, and units for the output channels + ! If a selected output channel is not available in this module, set error flag. + !------------------------------------------------------------------------------------------------- + + ALLOCATE ( p%BldNd_OutParam(1:p%BldNd_NumOuts) , STAT=ErrStat2 ) + IF ( ErrStat2 /= 0_IntKi ) THEN + CALL SetErrStat( ErrID_Fatal,"Error allocating memory for the ElastoDyn BldNd_OutParam array.", ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + + + ! Set index, name, and units for all of the output channels. + ! If a selected output channel is not available by this module set ErrStat = ErrID_Warn. + + DO I = 1,p%BldNd_NumOuts + + p%BldNd_OutParam(I)%Name = BldNd_OutList(I) + OutListTmp = BldNd_OutList(I) + p%BldNd_OutParam(I)%SignM = 1 ! this won't be used + + CALL Conv2UC( OutListTmp ) ! Convert OutListTmp to upper case + + + Indx = IndexCharAry( OutListTmp(1:OutStrLenM1), ValidParamAry ) + + IF ( Indx > 0 ) THEN ! we found the channel name + IF ( InvalidOutput( ParamIndxAry(Indx) ) ) THEN ! but, it isn't valid for these settings + p%BldNd_OutParam(I)%Indx = 0 ! pick any valid channel (I just picked "Time=0" here because it's universal) + p%BldNd_OutParam(I)%Units = "INVALID" + p%BldNd_OutParam(I)%SignM = 0 + ELSE + p%BldNd_OutParam(I)%Indx = ParamIndxAry(Indx) + p%BldNd_OutParam(I)%Units = ParamUnitsAry(Indx) ! it's a valid output + END IF + ELSE ! this channel isn't valid + p%BldNd_OutParam(I)%Indx = 0 ! pick any valid channel (I just picked "Time=0" here because it's universal) + p%BldNd_OutParam(I)%Units = "INVALID" + p%BldNd_OutParam(I)%SignM = 0 ! multiply all results by zero + + CALL SetErrStat(ErrID_Fatal, TRIM(p%BldNd_OutParam(I)%Name)//" is not an available output channel.",ErrStat,ErrMsg,RoutineName) + END IF + + END DO + + RETURN +END SUBROUTINE BldNdOuts_SetOutParam +!---------------------------------------------------------------------------------------------------------------------------------- +!End of code generated by Matlab script +!********************************************************************************************************************************** + +END MODULE ElastoDyn_AllBldNdOuts_IO diff --git a/modules/elastodyn/src/ElastoDyn_IO.f90 b/modules/elastodyn/src/ElastoDyn_IO.f90 index 62689cea12..d097d0801b 100644 --- a/modules/elastodyn/src/ElastoDyn_IO.f90 +++ b/modules/elastodyn/src/ElastoDyn_IO.f90 @@ -26,6 +26,8 @@ MODULE ElastoDyn_Parameters USE NWTC_Library + USE ElastoDyn_AllBldNdOuts_IO + TYPE(ProgDesc), PARAMETER :: ED_Ver = ProgDesc( 'ElastoDyn', '', '' ) REAL(ReKi), PARAMETER :: SmallAngleLimit_Deg = 15.0 ! Largest input angle considered "small" (used as a check on input data), degrees @@ -61,7 +63,7 @@ MODULE ElastoDyn_Parameters INTEGER(IntKi), PARAMETER :: DOF_Teet = 22 !DOF_TFrl + 2*(NumBE+NumBF)+ 1 ! DOF index for rotor-teeter - + INTEGER(IntKi), PARAMETER :: ED_MaxDOFs = 24 INTEGER(IntKi), PARAMETER :: NPA = 9 ! Number of DOFs that contribute to the angular velocity of the tail (body A) in the inertia frame. @@ -3250,12 +3252,15 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, BldFile, FurlFile, TwrFile INTEGER(IntKi) :: ErrStat2 ! Temporary Error status LOGICAL :: Echo ! Determines if an echo file should be written CHARACTER(ErrMsgLen) :: ErrMsg2 ! Temporary Error message + CHARACTER(ErrMsgLen) :: ErrMsg_NoAllBldNdOuts ! Temporary Error message CHARACTER(*), PARAMETER :: RoutineName = 'ReadPrimaryFile' CHARACTER(1024) :: PriPath ! Path name of the primary file CHARACTER(1024) :: FTitle ! "File Title": the 2nd line of the input file, which contains a description of its contents CHARACTER(200) :: Line ! Temporary storage of a line from the input file (to compare with "default") - + ! Initialize some variables: + ErrStat = ErrID_None + ErrMsg = "" Echo = .FALSE. UnEc = -1 ! Echo file not opened, yet CALL GetPath( InputFile, PriPath ) ! Input files will be relative to the path where the primary input file is located. @@ -3306,6 +3311,10 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, BldFile, FurlFile, TwrFile RETURN END IF + ! Allocate array for holding the list of node outputs + CALL AllocAry( InputFileData%BldNd_OutList, BldNd_MaxOutPts, "BldNd_Outlist", ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ! Read the lines up/including to the "Echo" simulation control variable ! If echo is FALSE, don't write these lines to the echo file. @@ -4323,6 +4332,67 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, BldFile, FurlFile, TwrFile RETURN END IF + + !----------- OUTLIST ----------------------------------------------------------- + ! In case there is something ill-formed in the additional nodal outputs section, we will simply ignore it and assume that this section does not exist. + ErrMsg_NoAllBldNdOuts='Nodal outputs section of ElastoDyn input file not found or improperly formatted.' + + !----------- OUTLIST for BldNd ----------------------------------------------------------- + CALL ReadCom( UnIn, InputFile, 'Section Header: OutList for Blade node channels', ErrStat2, ErrMsg2, UnEc ) + IF ( ErrStat2 >= AbortErrLev ) THEN + InputFileData%BldNd_BladesOut = 0 + InputFileData%BldNd_NumOuts = 0 + call wrscr( trim(ErrMsg_NoAllBldNdOuts) ) + CALL Cleanup() + RETURN + ENDIF + + + ! Number of blade nodes to output: will modify this at some point for arrays + ! TODO: In a future release, allow this to be an array of N blade numbers (change BldNd_BladesOut to an array if we do that). + ! Will likely require reading this line in as a string (BldNd_BladesOut_Str) and parsing it + CALL ReadVar( UnIn, InputFile, InputFileData%BldNd_BladesOut, 'BldNd_BladesOut', 'Which blades to output node data on.'//TRIM(Num2Lstr(I)), ErrStat2, ErrMsg2, UnEc ) + IF ( ErrStat2 >= AbortErrLev ) THEN + InputFileData%BldNd_BladesOut = 0 + InputFileData%BldNd_NumOuts = 0 + call wrscr( trim(ErrMsg_NoAllBldNdOuts) ) + CALL Cleanup() + RETURN + ENDIF + + + ! Which blades to output for: will add this at some point + ! TODO: Parse this string into an array of nodes to output at (one idea is to set an array of boolean to T/F for which nodes to output). At present, we ignore it entirely. + CALL ReadVar( UnIn, InputFile, InputFileData%BldNd_BlOutNd_Str, 'BldNd_BlOutNd_Str', 'Which nodes to output node data on.'//TRIM(Num2Lstr(I)), ErrStat2, ErrMsg2, UnEc ) + IF ( ErrStat2 >= AbortErrLev ) THEN + InputFileData%BldNd_BladesOut = 0 + InputFileData%BldNd_NumOuts = 0 + call wrscr( trim(ErrMsg_NoAllBldNdOuts) ) + CALL Cleanup() + RETURN + ENDIF + + + ! Section header for outlist + CALL ReadCom( UnIn, InputFile, 'Section Header: OutList', ErrStat2, ErrMsg2, UnEc ) + IF ( ErrStat2 >= AbortErrLev ) THEN + InputFileData%BldNd_BladesOut = 0 + InputFileData%BldNd_NumOuts = 0 + call wrscr( trim(ErrMsg_NoAllBldNdOuts) ) + CALL Cleanup() + RETURN + ENDIF + + + ! OutList - List of user-requested output channels at each node(-): + CALL ReadOutputList ( UnIn, InputFile, InputFileData%BldNd_OutList, InputFileData%BldNd_NumOuts, 'BldNd_OutList', "List of user-requested output channels", ErrStat2, ErrMsg2, UnEc ) ! Routine in NWTC Subroutine Library + IF ( ErrStat2 >= AbortErrLev ) THEN + InputFileData%BldNd_BladesOut = 0 + InputFileData%BldNd_NumOuts = 0 + call wrscr( trim(ErrMsg_NoAllBldNdOuts) ) + CALL Cleanup() + RETURN + ENDIF !---------------------- END OF FILE ----------------------------------------- call cleanup() @@ -5185,11 +5255,12 @@ SUBROUTINE ValidatePrimaryData( InputFileData, BD4Blades, Linearize, ErrStat, Er END IF - ! Check that InputFileData%OutFmt is a valid format specifier and will fit over the column headings - CALL ChkRealFmtStr( InputFileData%OutFmt, 'OutFmt', FmtWidth, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2,ErrStat,ErrMsg,RoutineName ) - IF ( FmtWidth /= ChanLen ) CALL SetErrStat(ErrID_Warn, 'OutFmt produces a column width of '//TRIM(Num2LStr(FmtWidth))//& - ' instead of '//TRIM(Num2LStr(ChanLen))//' characters.',ErrStat,ErrMsg,RoutineName ) + !bjj: since ED doesn't actually use OutFmt at this point, I'm going to remove this check and warning message + !!!! ! Check that InputFileData%OutFmt is a valid format specifier and will fit over the column headings + !!!!CALL ChkRealFmtStr( InputFileData%OutFmt, 'OutFmt', FmtWidth, ErrStat2, ErrMsg2 ) + !!!!CALL SetErrStat(ErrStat2, ErrMsg2,ErrStat,ErrMsg,RoutineName ) + !!!!IF ( FmtWidth /= ChanLen ) CALL SetErrStat(ErrID_Warn, 'OutFmt produces a column width of '//TRIM(Num2LStr(FmtWidth))//& + !!!! ' instead of '//TRIM(Num2LStr(ChanLen))//' characters.',ErrStat,ErrMsg,RoutineName ) RETURN diff --git a/modules/elastodyn/src/ElastoDyn_Registry.txt b/modules/elastodyn/src/ElastoDyn_Registry.txt index 690c632c60..ed6dc2c2b9 100644 --- a/modules/elastodyn/src/ElastoDyn_Registry.txt +++ b/modules/elastodyn/src/ElastoDyn_Registry.txt @@ -40,6 +40,8 @@ typedef ^ InitOutputType ReKi TwrHNodes {:} - - "Location of variable-spaced tow typedef ^ InitOutputType ReKi PlatformPos {6} - - "Initial platform position (6 DOFs)" typedef ^ InitOutputType ReKi TwrBasePos {3} - - "initial position of the tower base (for SrvD)" m typedef ^ InitOutputType ReKi HubRad - - - "Preconed hub radius (distance from the rotor apex to the blade root)" m +typedef ^ InitOutputType ReKi RotSpeed - - - "Initial or fixed rotor speed" rad/s +typedef ^ InitOutputType LOGICAL isFixed_GenDOF - - - "whether the generator is fixed or free" - 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" - @@ -270,6 +272,12 @@ typedef ^ ED_InputFile ReKi TFrlUSDmp - - - "Tail-furl up-stop damping constant" typedef ^ ED_InputFile ReKi TFrlDSDmp - - - "Tail-furl down-stop damping constant" N-m/(rad/s) typedef ^ ED_InputFile IntKi method - - - "Identifier for integration method (1 [RK4], 2 [AB4], or 3 [ABM4])" - +# ..... ED_AllBldNdOuts compile option ............................................................................................ +typedef ^ ED_InputFile IntKi BldNd_NumOuts - - - "Number of requested output channels per blade node (ED_AllBldNdOuts)" - +typedef ^ ED_InputFile CHARACTER(ChanLen) BldNd_OutList {:} - - "List of user-requested output channels (ED_AllBldNdOuts)" - +#typedef ^ ED_InputFile IntKi BldNd_BlOutNd {:} - - "The blade nodes to actually output (ED_AllBldNdOuts)" - +typedef ^ ED_InputFile CHARACTER(1024) BldNd_BlOutNd_Str - - - "String to parse for the blade nodes to actually output (ED_AllBldNdOuts)" - +typedef ^ ED_InputFile IntKi BldNd_BladesOut - - - "The blades to output (ED_AllBldNdOuts)" - # ..... Internal data types ....................................................................................................... @@ -797,6 +805,13 @@ typedef ^ ParameterType ReKi PtfmCMxt - - - "Downwind distance from the ground [ typedef ^ ParameterType ReKi PtfmCMyt - - - "Lateral distance from the ground [onshore] or MSL [offshore] to the platform CM" meters typedef ^ ParameterType LOGICAL BD4Blades - - - "flag to determine if BeamDyn is computing blade loads (true) or ElastoDyn is (false)" - typedef ^ ParameterType LOGICAL UseAD14 - - - "flag to determine if AeroDyn14 is being used. Will remove this later when we've replaced AD14." - +# .... ED_AllBlNds option ........................................................................................................ +typedef ^ ParameterType IntKi BldNd_NumOuts - - - "Number of requested output channels per blade node (ED_AllBldNdOuts)" - +typedef ^ ParameterType IntKi BldNd_TotNumOuts - - - "Total number of requested output channels of blade node information (BldNd_NumOuts * BldNd_BlOutNd * BldNd_BladesOut -- ED_AllBldNdOuts)" - +typedef ^ ParameterType OutParmType BldNd_OutParam {:} - - "Names and units (and other characteristics) of all requested output parameters" - +#typedef ^ ParameterType IntKi BldNd_BlOutNd {:} - - "The blade nodes to actually output (ED_AllBldNdOuts)" - +typedef ^ ParameterType IntKi BldNd_BladesOut - - - "The blades to output (ED_AllBldNdOuts)" - + 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 {:} - - "vector that determines size of perturbation for x (continuous states)" @@ -812,7 +827,7 @@ typedef ^ InputType MeshType NacelleLoads - - - "From ServoDyn/TMD: loads on the # Define inputs that are not on a mesh here: typedef ^ InputType ReKi TwrAddedMass {:}{:}{:} - - "6-by-6 added mass matrix of the tower elements, per unit length-bjj: place on a mesh" "per unit length" typedef ^ InputType ReKi PtfmAddedMass {6}{6} - - "Platform added mass matrix" "kg, kg-m, kg-m^2" -typedef ^ InputType ReKi BlPitchCom {:} - - "Commanded blade pitch angles" radians +typedef ^ InputType ReKi BlPitchCom {:} - 2pi "Commanded blade pitch angles" radians typedef ^ InputType ReKi YawMom - - - "Torque transmitted through the yaw bearing" N-m typedef ^ InputType ReKi GenTrq - - - "Electrical generator torque" N-m typedef ^ InputType ReKi HSSBrTrqC - - - "Commanded HSS brake torque" N-m @@ -832,18 +847,18 @@ typedef ^ OutputType MeshType TowerBaseMotion14 - - - "For AeroDyn 14: motions o # Define outputs that are not on this mesh here: typedef ^ OutputType ReKi WriteOutput {:} - - "Data to be written to an output file: see WriteOutputHdr for names of each variable" "see WriteOutputUnt" -typedef ^ OutputType ReKi BlPitch {:} - - "Current blade pitch angles" radians -typedef ^ OutputType ReKi Yaw - - - "Current nacelle yaw" radians +typedef ^ OutputType ReKi BlPitch {:} - 2pi "Current blade pitch angles" radians +typedef ^ OutputType ReKi Yaw - - 2pi "Current nacelle yaw" radians typedef ^ OutputType ReKi YawRate - - - "Current nacelle yaw rate" rad/s typedef ^ OutputType ReKi LSS_Spd - - - "Low-speed shaft (LSS) speed at entrance to gearbox" rad/s typedef ^ OutputType ReKi HSS_Spd - - - "High-speed shaft (HSS) speed" rad/s typedef ^ OutputType ReKi RotSpeed - - - "Rotor azimuth angular speed" rad/s typedef ^ OutputType ReKi TwrAccel - - - "Tower acceleration for tower feedback control (user routine only)" m/s^2 -typedef ^ OutputType ReKi YawAngle - - - "Yaw angle to be used for yaw error calculations" radians +typedef ^ OutputType ReKi YawAngle - - 2pi "Yaw angle to be used for yaw error calculations" radians typedef ^ OutputType ReKi RootMyc 3 - - "Out-of-plane moment (i.e., the moment caused by out-of-plane forces) at the blade root for each of the blades (max 3)" N-m typedef ^ OutputType ReKi YawBrTAxp - - - "Tower-top / yaw bearing fore-aft (translational) acceleration (absolute)" m/s^2 typedef ^ OutputType ReKi YawBrTAyp - - - "Tower-top / yaw bearing side-to-side (translational) acceleration (absolute)" m/s^2 -typedef ^ OutputType ReKi LSSTipPxa - - - "Rotor azimuth angle (position)" radians +typedef ^ OutputType ReKi LSSTipPxa - - 2pi "Rotor azimuth angle (position)" radians typedef ^ OutputType ReKi RootMxc 3 - - "In-plane moment (i.e., the moment caused by in-plane forces) at the blade root" N-m typedef ^ OutputType ReKi LSSTipMxa - - - "Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader)" N-m typedef ^ OutputType ReKi LSSTipMya - - - "Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader)" N-m diff --git a/modules/elastodyn/src/ElastoDyn_Types.f90 b/modules/elastodyn/src/ElastoDyn_Types.f90 index 5f1a925e73..35338dc227 100644 --- a/modules/elastodyn/src/ElastoDyn_Types.f90 +++ b/modules/elastodyn/src/ElastoDyn_Types.f90 @@ -60,6 +60,8 @@ MODULE ElastoDyn_Types REAL(ReKi) , DIMENSION(1:6) :: PlatformPos !< Initial platform position (6 DOFs) [-] REAL(ReKi) , DIMENSION(1:3) :: TwrBasePos !< initial position of the tower base (for SrvD) [m] REAL(ReKi) :: HubRad !< Preconed hub radius (distance from the rotor apex to the blade root) [m] + REAL(ReKi) :: RotSpeed !< Initial or fixed rotor speed [rad/s] + LOGICAL :: isFixed_GenDOF !< whether the generator is fixed or free [-] 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 [-] @@ -286,6 +288,10 @@ MODULE ElastoDyn_Types REAL(ReKi) :: TFrlUSDmp !< Tail-furl up-stop damping constant [N-m/(rad/s)] REAL(ReKi) :: TFrlDSDmp !< Tail-furl down-stop damping constant [N-m/(rad/s)] INTEGER(IntKi) :: method !< Identifier for integration method (1 [RK4], 2 [AB4], or 3 [ABM4]) [-] + INTEGER(IntKi) :: BldNd_NumOuts !< Number of requested output channels per blade node (ED_AllBldNdOuts) [-] + CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: BldNd_OutList !< List of user-requested output channels (ED_AllBldNdOuts) [-] + CHARACTER(1024) :: BldNd_BlOutNd_Str !< String to parse for the blade nodes to actually output (ED_AllBldNdOuts) [-] + INTEGER(IntKi) :: BldNd_BladesOut !< The blades to output (ED_AllBldNdOuts) [-] END TYPE ED_InputFile ! ======================= ! ========= ED_CoordSys ======= @@ -801,6 +807,10 @@ MODULE ElastoDyn_Types REAL(ReKi) :: PtfmCMyt !< Lateral distance from the ground [onshore] or MSL [offshore] to the platform CM [meters] LOGICAL :: BD4Blades !< flag to determine if BeamDyn is computing blade loads (true) or ElastoDyn is (false) [-] LOGICAL :: UseAD14 !< flag to determine if AeroDyn14 is being used. Will remove this later when we've replaced AD14. [-] + INTEGER(IntKi) :: BldNd_NumOuts !< Number of requested output channels per blade node (ED_AllBldNdOuts) [-] + INTEGER(IntKi) :: BldNd_TotNumOuts !< Total number of requested output channels of blade node information (BldNd_NumOuts * BldNd_BlOutNd * BldNd_BladesOut -- ED_AllBldNdOuts) [-] + TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: BldNd_OutParam !< Names and units (and other characteristics) of all requested output parameters [-] + INTEGER(IntKi) :: BldNd_BladesOut !< The blades to output (ED_AllBldNdOuts) [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Jac_u_indx !< matrix to help fill/pack the u vector in computing the jacobian [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: du !< vector that determines size of perturbation for u (inputs) [-] REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: dx !< vector that determines size of perturbation for x (continuous states) [-] @@ -966,22 +976,22 @@ SUBROUTINE ED_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Linearize , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%ADInputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%ADInputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%CompElast , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(InData%InputFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%Linearize, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%ADInputFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%ADInputFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%CompElast, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE ED_PackInitInput SUBROUTINE ED_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -997,12 +1007,6 @@ SUBROUTINE ED_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (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 @@ -1021,22 +1025,22 @@ SUBROUTINE ED_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%InputFile) - OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%Linearize = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%ADInputFile) - OutData%ADInputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%CompElast = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%InputFile) + OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%Linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%Linearize) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%ADInputFile) + OutData%ADInputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%CompElast = TRANSFER(IntKiBuf(Int_Xferred), OutData%CompElast) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE ED_UnPackInitInput SUBROUTINE ED_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -1126,6 +1130,8 @@ SUBROUTINE ED_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, Er DstInitOutputData%PlatformPos = SrcInitOutputData%PlatformPos DstInitOutputData%TwrBasePos = SrcInitOutputData%TwrBasePos DstInitOutputData%HubRad = SrcInitOutputData%HubRad + DstInitOutputData%RotSpeed = SrcInitOutputData%RotSpeed + DstInitOutputData%isFixed_GenDOF = SrcInitOutputData%isFixed_GenDOF IF (ALLOCATED(SrcInitOutputData%LinNames_y)) THEN i1_l = LBOUND(SrcInitOutputData%LinNames_y,1) i1_u = UBOUND(SrcInitOutputData%LinNames_y,1) @@ -1362,6 +1368,8 @@ SUBROUTINE ED_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Re_BufSz = Re_BufSz + SIZE(InData%PlatformPos) ! PlatformPos Re_BufSz = Re_BufSz + SIZE(InData%TwrBasePos) ! TwrBasePos Re_BufSz = Re_BufSz + 1 ! HubRad + Re_BufSz = Re_BufSz + 1 ! RotSpeed + Int_BufSz = Int_BufSz + 1 ! isFixed_GenDOF Int_BufSz = Int_BufSz + 1 ! LinNames_y allocated yes/no IF ( ALLOCATED(InData%LinNames_y) ) THEN Int_BufSz = Int_BufSz + 2*1 ! LinNames_y upper/lower bounds for each dimension @@ -1439,12 +1447,12 @@ SUBROUTINE ED_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1456,12 +1464,12 @@ SUBROUTINE ED_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + 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) @@ -1491,10 +1499,10 @@ SUBROUTINE ED_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumBl - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Gravity - Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumBl + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Gravity + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%BlPitch) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1505,17 +1513,19 @@ SUBROUTINE ED_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlPitch,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BlPitch)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlPitch))-1 ) = PACK(InData%BlPitch,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlPitch) + DO i1 = LBOUND(InData%BlPitch,1), UBOUND(InData%BlPitch,1) + ReKiBuf(Re_Xferred) = InData%BlPitch(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%BladeLength - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TowerHeight - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TowerBaseHeight - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HubHt - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%BladeLength + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TowerHeight + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TowerBaseHeight + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HubHt + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%BldRNodes) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1526,8 +1536,10 @@ SUBROUTINE ED_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldRNodes,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BldRNodes)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BldRNodes))-1 ) = PACK(InData%BldRNodes,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BldRNodes) + DO i1 = LBOUND(InData%BldRNodes,1), UBOUND(InData%BldRNodes,1) + ReKiBuf(Re_Xferred) = InData%BldRNodes(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TwrHNodes) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1539,15 +1551,25 @@ SUBROUTINE ED_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrHNodes,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwrHNodes)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwrHNodes))-1 ) = PACK(InData%TwrHNodes,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwrHNodes) + DO i1 = LBOUND(InData%TwrHNodes,1), UBOUND(InData%TwrHNodes,1) + ReKiBuf(Re_Xferred) = InData%TwrHNodes(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PlatformPos))-1 ) = PACK(InData%PlatformPos,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PlatformPos) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwrBasePos))-1 ) = PACK(InData%TwrBasePos,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwrBasePos) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HubRad - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%PlatformPos,1), UBOUND(InData%PlatformPos,1) + ReKiBuf(Re_Xferred) = InData%PlatformPos(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%TwrBasePos,1), UBOUND(InData%TwrBasePos,1) + ReKiBuf(Re_Xferred) = InData%TwrBasePos(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%HubRad + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RotSpeed + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%isFixed_GenDOF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%LinNames_y) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1558,12 +1580,12 @@ SUBROUTINE ED_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_y,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%LinNames_y,1), UBOUND(InData%LinNames_y,1) + DO 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LinNames_x) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1575,12 +1597,12 @@ SUBROUTINE ED_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_x,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%LinNames_x,1), UBOUND(InData%LinNames_x,1) + DO 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LinNames_u) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1592,12 +1614,12 @@ SUBROUTINE ED_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_u,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%LinNames_u,1), UBOUND(InData%LinNames_u,1) + DO 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%RotFrame_y) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1609,8 +1631,10 @@ SUBROUTINE ED_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_y,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RotFrame_y)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%RotFrame_y)-1 ) = TRANSFER(PACK( InData%RotFrame_y ,.TRUE.), IntKiBuf(1), SIZE(InData%RotFrame_y)) - Int_Xferred = Int_Xferred + SIZE(InData%RotFrame_y) + DO i1 = LBOUND(InData%RotFrame_y,1), UBOUND(InData%RotFrame_y,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_y(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%RotFrame_x) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1622,8 +1646,10 @@ SUBROUTINE ED_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_x,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RotFrame_x)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%RotFrame_x)-1 ) = TRANSFER(PACK( InData%RotFrame_x ,.TRUE.), IntKiBuf(1), SIZE(InData%RotFrame_x)) - Int_Xferred = Int_Xferred + SIZE(InData%RotFrame_x) + DO i1 = LBOUND(InData%RotFrame_x,1), UBOUND(InData%RotFrame_x,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_x(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%DerivOrder_x) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1635,8 +1661,10 @@ SUBROUTINE ED_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DerivOrder_x,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DerivOrder_x)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%DerivOrder_x))-1 ) = PACK(InData%DerivOrder_x,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%DerivOrder_x) + DO i1 = LBOUND(InData%DerivOrder_x,1), UBOUND(InData%DerivOrder_x,1) + IntKiBuf(Int_Xferred) = InData%DerivOrder_x(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%RotFrame_u) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1648,8 +1676,10 @@ SUBROUTINE ED_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_u,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RotFrame_u)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%RotFrame_u)-1 ) = TRANSFER(PACK( InData%RotFrame_u ,.TRUE.), IntKiBuf(1), SIZE(InData%RotFrame_u)) - Int_Xferred = Int_Xferred + SIZE(InData%RotFrame_u) + 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 @@ -1661,8 +1691,10 @@ SUBROUTINE ED_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IsLoad_u,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%IsLoad_u)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%IsLoad_u)-1 ) = TRANSFER(PACK( InData%IsLoad_u ,.TRUE.), IntKiBuf(1), SIZE(InData%IsLoad_u)) - Int_Xferred = Int_Xferred + SIZE(InData%IsLoad_u) + DO i1 = LBOUND(InData%IsLoad_u,1), UBOUND(InData%IsLoad_u,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%IsLoad_u(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF END SUBROUTINE ED_PackInitOutput @@ -1679,12 +1711,6 @@ SUBROUTINE ED_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1712,19 +1738,12 @@ SUBROUTINE ED_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated Int_Xferred = Int_Xferred + 1 @@ -1739,19 +1758,12 @@ SUBROUTINE ED_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -1793,10 +1805,10 @@ SUBROUTINE ED_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%NumBl = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%Gravity = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%NumBl = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%Gravity = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlPitch not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1810,24 +1822,19 @@ SUBROUTINE ED_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitch.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BlPitch)>0) OutData%BlPitch = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlPitch))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlPitch) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BlPitch,1), UBOUND(OutData%BlPitch,1) + OutData%BlPitch(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%BladeLength = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TowerHeight = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TowerBaseHeight = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HubHt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%BladeLength = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TowerHeight = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TowerBaseHeight = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HubHt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldRNodes not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1841,15 +1848,10 @@ SUBROUTINE ED_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldRNodes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BldRNodes)>0) OutData%BldRNodes = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BldRNodes))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BldRNodes) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BldRNodes,1), UBOUND(OutData%BldRNodes,1) + OutData%BldRNodes(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrHNodes not allocated Int_Xferred = Int_Xferred + 1 @@ -1864,40 +1866,29 @@ SUBROUTINE ED_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrHNodes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwrHNodes)>0) OutData%TwrHNodes = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwrHNodes))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwrHNodes) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwrHNodes,1), UBOUND(OutData%TwrHNodes,1) + OutData%TwrHNodes(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF i1_l = LBOUND(OutData%PlatformPos,1) i1_u = UBOUND(OutData%PlatformPos,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%PlatformPos = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PlatformPos))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PlatformPos) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%PlatformPos,1), UBOUND(OutData%PlatformPos,1) + OutData%PlatformPos(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%TwrBasePos,1) i1_u = UBOUND(OutData%TwrBasePos,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%TwrBasePos = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwrBasePos))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwrBasePos) - DEALLOCATE(mask1) - OutData%HubRad = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%TwrBasePos,1), UBOUND(OutData%TwrBasePos,1) + OutData%TwrBasePos(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%HubRad = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RotSpeed = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%isFixed_GenDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%isFixed_GenDOF) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_y not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1911,19 +1902,12 @@ SUBROUTINE ED_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%LinNames_y,1), UBOUND(OutData%LinNames_y,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_x not allocated Int_Xferred = Int_Xferred + 1 @@ -1938,19 +1922,12 @@ SUBROUTINE ED_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_x.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%LinNames_x,1), UBOUND(OutData%LinNames_x,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_u not allocated Int_Xferred = Int_Xferred + 1 @@ -1965,19 +1942,12 @@ SUBROUTINE ED_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%LinNames_u,1), UBOUND(OutData%LinNames_u,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_y not allocated Int_Xferred = Int_Xferred + 1 @@ -1992,15 +1962,10 @@ SUBROUTINE ED_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%RotFrame_y)>0) OutData%RotFrame_y = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%RotFrame_y))-1 ), OutData%RotFrame_y), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%RotFrame_y) - DEALLOCATE(mask1) + 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 @@ -2015,15 +1980,10 @@ SUBROUTINE ED_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_x.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%RotFrame_x)>0) OutData%RotFrame_x = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%RotFrame_x))-1 ), OutData%RotFrame_x), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%RotFrame_x) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%RotFrame_x,1), UBOUND(OutData%RotFrame_x,1) + OutData%RotFrame_x(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_x(i1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DerivOrder_x not allocated Int_Xferred = Int_Xferred + 1 @@ -2038,15 +1998,10 @@ SUBROUTINE ED_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%DerivOrder_x)>0) OutData%DerivOrder_x = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%DerivOrder_x))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%DerivOrder_x) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%DerivOrder_x,1), UBOUND(OutData%DerivOrder_x,1) + OutData%DerivOrder_x(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_u not allocated Int_Xferred = Int_Xferred + 1 @@ -2061,15 +2016,10 @@ SUBROUTINE ED_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%RotFrame_u)>0) OutData%RotFrame_u = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%RotFrame_u))-1 ), OutData%RotFrame_u), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%RotFrame_u) - DEALLOCATE(mask1) + 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 @@ -2084,15 +2034,10 @@ SUBROUTINE ED_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%IsLoad_u)>0) OutData%IsLoad_u = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%IsLoad_u))-1 ), OutData%IsLoad_u), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%IsLoad_u) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%IsLoad_u,1), UBOUND(OutData%IsLoad_u,1) + OutData%IsLoad_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsLoad_u(i1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF END SUBROUTINE ED_UnPackInitOutput @@ -2594,8 +2539,8 @@ SUBROUTINE ED_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NBlInpSt - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NBlInpSt + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%BlFract) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2606,8 +2551,10 @@ SUBROUTINE ED_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlFract,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BlFract)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlFract))-1 ) = PACK(InData%BlFract,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlFract) + DO i1 = LBOUND(InData%BlFract,1), UBOUND(InData%BlFract,1) + ReKiBuf(Re_Xferred) = InData%BlFract(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%PitchAx) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2619,8 +2566,10 @@ SUBROUTINE ED_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PitchAx,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PitchAx)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PitchAx))-1 ) = PACK(InData%PitchAx,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PitchAx) + DO i1 = LBOUND(InData%PitchAx,1), UBOUND(InData%PitchAx,1) + ReKiBuf(Re_Xferred) = InData%PitchAx(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%StrcTwst) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2632,8 +2581,10 @@ SUBROUTINE ED_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StrcTwst,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%StrcTwst)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%StrcTwst))-1 ) = PACK(InData%StrcTwst,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%StrcTwst) + DO i1 = LBOUND(InData%StrcTwst,1), UBOUND(InData%StrcTwst,1) + ReKiBuf(Re_Xferred) = InData%StrcTwst(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%BMassDen) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2645,8 +2596,10 @@ SUBROUTINE ED_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BMassDen,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BMassDen)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BMassDen))-1 ) = PACK(InData%BMassDen,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BMassDen) + DO i1 = LBOUND(InData%BMassDen,1), UBOUND(InData%BMassDen,1) + ReKiBuf(Re_Xferred) = InData%BMassDen(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%FlpStff) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2658,8 +2611,10 @@ SUBROUTINE ED_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FlpStff,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FlpStff)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FlpStff))-1 ) = PACK(InData%FlpStff,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FlpStff) + DO i1 = LBOUND(InData%FlpStff,1), UBOUND(InData%FlpStff,1) + ReKiBuf(Re_Xferred) = InData%FlpStff(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%EdgStff) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2671,8 +2626,10 @@ SUBROUTINE ED_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%EdgStff,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%EdgStff)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%EdgStff))-1 ) = PACK(InData%EdgStff,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%EdgStff) + DO i1 = LBOUND(InData%EdgStff,1), UBOUND(InData%EdgStff,1) + ReKiBuf(Re_Xferred) = InData%EdgStff(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%GJStff) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2684,8 +2641,10 @@ SUBROUTINE ED_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GJStff,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%GJStff)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GJStff))-1 ) = PACK(InData%GJStff,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GJStff) + DO i1 = LBOUND(InData%GJStff,1), UBOUND(InData%GJStff,1) + ReKiBuf(Re_Xferred) = InData%GJStff(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%EAStff) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2697,8 +2656,10 @@ SUBROUTINE ED_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%EAStff,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%EAStff)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%EAStff))-1 ) = PACK(InData%EAStff,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%EAStff) + DO i1 = LBOUND(InData%EAStff,1), UBOUND(InData%EAStff,1) + ReKiBuf(Re_Xferred) = InData%EAStff(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%Alpha) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2710,8 +2671,10 @@ SUBROUTINE ED_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Alpha,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Alpha)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Alpha))-1 ) = PACK(InData%Alpha,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Alpha) + DO i1 = LBOUND(InData%Alpha,1), UBOUND(InData%Alpha,1) + ReKiBuf(Re_Xferred) = InData%Alpha(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%FlpIner) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2723,8 +2686,10 @@ SUBROUTINE ED_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FlpIner,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FlpIner)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FlpIner))-1 ) = PACK(InData%FlpIner,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FlpIner) + DO i1 = LBOUND(InData%FlpIner,1), UBOUND(InData%FlpIner,1) + ReKiBuf(Re_Xferred) = InData%FlpIner(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%EdgIner) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2736,8 +2701,10 @@ SUBROUTINE ED_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%EdgIner,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%EdgIner)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%EdgIner))-1 ) = PACK(InData%EdgIner,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%EdgIner) + DO i1 = LBOUND(InData%EdgIner,1), UBOUND(InData%EdgIner,1) + ReKiBuf(Re_Xferred) = InData%EdgIner(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%PrecrvRef) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2749,8 +2716,10 @@ SUBROUTINE ED_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PrecrvRef,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PrecrvRef)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PrecrvRef))-1 ) = PACK(InData%PrecrvRef,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PrecrvRef) + DO i1 = LBOUND(InData%PrecrvRef,1), UBOUND(InData%PrecrvRef,1) + ReKiBuf(Re_Xferred) = InData%PrecrvRef(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%PreswpRef) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2762,8 +2731,10 @@ SUBROUTINE ED_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PreswpRef,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PreswpRef)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PreswpRef))-1 ) = PACK(InData%PreswpRef,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PreswpRef) + DO i1 = LBOUND(InData%PreswpRef,1), UBOUND(InData%PreswpRef,1) + ReKiBuf(Re_Xferred) = InData%PreswpRef(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%FlpcgOf) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2775,8 +2746,10 @@ SUBROUTINE ED_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FlpcgOf,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FlpcgOf)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FlpcgOf))-1 ) = PACK(InData%FlpcgOf,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FlpcgOf) + DO i1 = LBOUND(InData%FlpcgOf,1), UBOUND(InData%FlpcgOf,1) + ReKiBuf(Re_Xferred) = InData%FlpcgOf(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%EdgcgOf) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2788,8 +2761,10 @@ SUBROUTINE ED_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%EdgcgOf,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%EdgcgOf)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%EdgcgOf))-1 ) = PACK(InData%EdgcgOf,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%EdgcgOf) + DO i1 = LBOUND(InData%EdgcgOf,1), UBOUND(InData%EdgcgOf,1) + ReKiBuf(Re_Xferred) = InData%EdgcgOf(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%FlpEAOf) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2801,8 +2776,10 @@ SUBROUTINE ED_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FlpEAOf,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FlpEAOf)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FlpEAOf))-1 ) = PACK(InData%FlpEAOf,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FlpEAOf) + DO i1 = LBOUND(InData%FlpEAOf,1), UBOUND(InData%FlpEAOf,1) + ReKiBuf(Re_Xferred) = InData%FlpEAOf(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%EdgEAOf) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2814,15 +2791,23 @@ SUBROUTINE ED_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%EdgEAOf,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%EdgEAOf)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%EdgEAOf))-1 ) = PACK(InData%EdgEAOf,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%EdgEAOf) + DO i1 = LBOUND(InData%EdgEAOf,1), UBOUND(InData%EdgEAOf,1) + ReKiBuf(Re_Xferred) = InData%EdgEAOf(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BldFlDmp))-1 ) = PACK(InData%BldFlDmp,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BldFlDmp) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BldEdDmp))-1 ) = PACK(InData%BldEdDmp,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BldEdDmp) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FlStTunr))-1 ) = PACK(InData%FlStTunr,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FlStTunr) + DO i1 = LBOUND(InData%BldFlDmp,1), UBOUND(InData%BldFlDmp,1) + ReKiBuf(Re_Xferred) = InData%BldFlDmp(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%BldEdDmp,1), UBOUND(InData%BldEdDmp,1) + ReKiBuf(Re_Xferred) = InData%BldEdDmp(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%FlStTunr,1), UBOUND(InData%FlStTunr,1) + ReKiBuf(Re_Xferred) = InData%FlStTunr(i1) + Re_Xferred = Re_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%BldFl1Sh) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2833,8 +2818,10 @@ SUBROUTINE ED_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldFl1Sh,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BldFl1Sh)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BldFl1Sh))-1 ) = PACK(InData%BldFl1Sh,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BldFl1Sh) + DO i1 = LBOUND(InData%BldFl1Sh,1), UBOUND(InData%BldFl1Sh,1) + ReKiBuf(Re_Xferred) = InData%BldFl1Sh(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%BldFl2Sh) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2846,8 +2833,10 @@ SUBROUTINE ED_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldFl2Sh,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BldFl2Sh)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BldFl2Sh))-1 ) = PACK(InData%BldFl2Sh,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BldFl2Sh) + DO i1 = LBOUND(InData%BldFl2Sh,1), UBOUND(InData%BldFl2Sh,1) + ReKiBuf(Re_Xferred) = InData%BldFl2Sh(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%BldEdgSh) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2859,8 +2848,10 @@ SUBROUTINE ED_PackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldEdgSh,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BldEdgSh)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BldEdgSh))-1 ) = PACK(InData%BldEdgSh,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BldEdgSh) + DO i1 = LBOUND(InData%BldEdgSh,1), UBOUND(InData%BldEdgSh,1) + ReKiBuf(Re_Xferred) = InData%BldEdgSh(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE ED_PackBladeInputData @@ -2877,12 +2868,6 @@ SUBROUTINE ED_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -2897,8 +2882,8 @@ SUBROUTINE ED_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%NBlInpSt = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NBlInpSt = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlFract not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -2912,15 +2897,10 @@ SUBROUTINE ED_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlFract.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BlFract)>0) OutData%BlFract = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlFract))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlFract) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BlFract,1), UBOUND(OutData%BlFract,1) + OutData%BlFract(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PitchAx not allocated Int_Xferred = Int_Xferred + 1 @@ -2935,15 +2915,10 @@ SUBROUTINE ED_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PitchAx.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%PitchAx)>0) OutData%PitchAx = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PitchAx))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PitchAx) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%PitchAx,1), UBOUND(OutData%PitchAx,1) + OutData%PitchAx(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StrcTwst not allocated Int_Xferred = Int_Xferred + 1 @@ -2958,15 +2933,10 @@ SUBROUTINE ED_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StrcTwst.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%StrcTwst)>0) OutData%StrcTwst = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%StrcTwst))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%StrcTwst) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%StrcTwst,1), UBOUND(OutData%StrcTwst,1) + OutData%StrcTwst(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BMassDen not allocated Int_Xferred = Int_Xferred + 1 @@ -2981,15 +2951,10 @@ SUBROUTINE ED_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BMassDen.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BMassDen)>0) OutData%BMassDen = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BMassDen))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BMassDen) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BMassDen,1), UBOUND(OutData%BMassDen,1) + OutData%BMassDen(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FlpStff not allocated Int_Xferred = Int_Xferred + 1 @@ -3004,15 +2969,10 @@ SUBROUTINE ED_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FlpStff.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%FlpStff)>0) OutData%FlpStff = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FlpStff))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FlpStff) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FlpStff,1), UBOUND(OutData%FlpStff,1) + OutData%FlpStff(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! EdgStff not allocated Int_Xferred = Int_Xferred + 1 @@ -3027,15 +2987,10 @@ SUBROUTINE ED_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%EdgStff.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%EdgStff)>0) OutData%EdgStff = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%EdgStff))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%EdgStff) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%EdgStff,1), UBOUND(OutData%EdgStff,1) + OutData%EdgStff(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GJStff not allocated Int_Xferred = Int_Xferred + 1 @@ -3050,15 +3005,10 @@ SUBROUTINE ED_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GJStff.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%GJStff)>0) OutData%GJStff = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GJStff))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GJStff) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%GJStff,1), UBOUND(OutData%GJStff,1) + OutData%GJStff(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! EAStff not allocated Int_Xferred = Int_Xferred + 1 @@ -3073,15 +3023,10 @@ SUBROUTINE ED_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%EAStff.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%EAStff)>0) OutData%EAStff = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%EAStff))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%EAStff) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%EAStff,1), UBOUND(OutData%EAStff,1) + OutData%EAStff(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Alpha not allocated Int_Xferred = Int_Xferred + 1 @@ -3096,15 +3041,10 @@ SUBROUTINE ED_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Alpha.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Alpha)>0) OutData%Alpha = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Alpha))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Alpha) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Alpha,1), UBOUND(OutData%Alpha,1) + OutData%Alpha(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FlpIner not allocated Int_Xferred = Int_Xferred + 1 @@ -3119,15 +3059,10 @@ SUBROUTINE ED_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FlpIner.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%FlpIner)>0) OutData%FlpIner = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FlpIner))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FlpIner) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FlpIner,1), UBOUND(OutData%FlpIner,1) + OutData%FlpIner(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! EdgIner not allocated Int_Xferred = Int_Xferred + 1 @@ -3142,15 +3077,10 @@ SUBROUTINE ED_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%EdgIner.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%EdgIner)>0) OutData%EdgIner = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%EdgIner))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%EdgIner) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%EdgIner,1), UBOUND(OutData%EdgIner,1) + OutData%EdgIner(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PrecrvRef not allocated Int_Xferred = Int_Xferred + 1 @@ -3165,15 +3095,10 @@ SUBROUTINE ED_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PrecrvRef.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%PrecrvRef)>0) OutData%PrecrvRef = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PrecrvRef))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PrecrvRef) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%PrecrvRef,1), UBOUND(OutData%PrecrvRef,1) + OutData%PrecrvRef(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PreswpRef not allocated Int_Xferred = Int_Xferred + 1 @@ -3188,15 +3113,10 @@ SUBROUTINE ED_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PreswpRef.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%PreswpRef)>0) OutData%PreswpRef = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PreswpRef))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PreswpRef) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%PreswpRef,1), UBOUND(OutData%PreswpRef,1) + OutData%PreswpRef(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FlpcgOf not allocated Int_Xferred = Int_Xferred + 1 @@ -3211,15 +3131,10 @@ SUBROUTINE ED_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FlpcgOf.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%FlpcgOf)>0) OutData%FlpcgOf = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FlpcgOf))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FlpcgOf) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FlpcgOf,1), UBOUND(OutData%FlpcgOf,1) + OutData%FlpcgOf(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! EdgcgOf not allocated Int_Xferred = Int_Xferred + 1 @@ -3234,15 +3149,10 @@ SUBROUTINE ED_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%EdgcgOf.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%EdgcgOf)>0) OutData%EdgcgOf = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%EdgcgOf))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%EdgcgOf) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%EdgcgOf,1), UBOUND(OutData%EdgcgOf,1) + OutData%EdgcgOf(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FlpEAOf not allocated Int_Xferred = Int_Xferred + 1 @@ -3257,15 +3167,10 @@ SUBROUTINE ED_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FlpEAOf.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%FlpEAOf)>0) OutData%FlpEAOf = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FlpEAOf))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FlpEAOf) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FlpEAOf,1), UBOUND(OutData%FlpEAOf,1) + OutData%FlpEAOf(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! EdgEAOf not allocated Int_Xferred = Int_Xferred + 1 @@ -3280,49 +3185,29 @@ SUBROUTINE ED_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%EdgEAOf.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%EdgEAOf)>0) OutData%EdgEAOf = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%EdgEAOf))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%EdgEAOf) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%EdgEAOf,1), UBOUND(OutData%EdgEAOf,1) + OutData%EdgEAOf(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF i1_l = LBOUND(OutData%BldFlDmp,1) i1_u = UBOUND(OutData%BldFlDmp,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%BldFlDmp = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BldFlDmp))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BldFlDmp) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BldFlDmp,1), UBOUND(OutData%BldFlDmp,1) + OutData%BldFlDmp(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%BldEdDmp,1) i1_u = UBOUND(OutData%BldEdDmp,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%BldEdDmp = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BldEdDmp))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BldEdDmp) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BldEdDmp,1), UBOUND(OutData%BldEdDmp,1) + OutData%BldEdDmp(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%FlStTunr,1) i1_u = UBOUND(OutData%FlStTunr,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%FlStTunr = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FlStTunr))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FlStTunr) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FlStTunr,1), UBOUND(OutData%FlStTunr,1) + OutData%FlStTunr(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldFl1Sh not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3336,15 +3221,10 @@ SUBROUTINE ED_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldFl1Sh.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BldFl1Sh)>0) OutData%BldFl1Sh = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BldFl1Sh))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BldFl1Sh) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BldFl1Sh,1), UBOUND(OutData%BldFl1Sh,1) + OutData%BldFl1Sh(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldFl2Sh not allocated Int_Xferred = Int_Xferred + 1 @@ -3359,15 +3239,10 @@ SUBROUTINE ED_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldFl2Sh.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BldFl2Sh)>0) OutData%BldFl2Sh = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BldFl2Sh))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BldFl2Sh) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BldFl2Sh,1), UBOUND(OutData%BldFl2Sh,1) + OutData%BldFl2Sh(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldEdgSh not allocated Int_Xferred = Int_Xferred + 1 @@ -3382,15 +3257,10 @@ SUBROUTINE ED_UnPackBladeInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldEdgSh.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BldEdgSh)>0) OutData%BldEdgSh = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BldEdgSh))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BldEdgSh) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BldEdgSh,1), UBOUND(OutData%BldEdgSh,1) + OutData%BldEdgSh(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE ED_UnPackBladeInputData @@ -3546,8 +3416,8 @@ SUBROUTINE ED_PackBladeMeshInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%BldNodes - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%BldNodes + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%RNodes) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -3558,8 +3428,10 @@ SUBROUTINE ED_PackBladeMeshInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RNodes,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RNodes)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RNodes))-1 ) = PACK(InData%RNodes,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RNodes) + DO i1 = LBOUND(InData%RNodes,1), UBOUND(InData%RNodes,1) + ReKiBuf(Re_Xferred) = InData%RNodes(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%AeroTwst) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3571,8 +3443,10 @@ SUBROUTINE ED_PackBladeMeshInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AeroTwst,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AeroTwst)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AeroTwst))-1 ) = PACK(InData%AeroTwst,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AeroTwst) + DO i1 = LBOUND(InData%AeroTwst,1), UBOUND(InData%AeroTwst,1) + ReKiBuf(Re_Xferred) = InData%AeroTwst(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%Chord) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3584,8 +3458,10 @@ SUBROUTINE ED_PackBladeMeshInputData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Chord,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Chord)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Chord))-1 ) = PACK(InData%Chord,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Chord) + DO i1 = LBOUND(InData%Chord,1), UBOUND(InData%Chord,1) + ReKiBuf(Re_Xferred) = InData%Chord(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE ED_PackBladeMeshInputData @@ -3602,12 +3478,6 @@ SUBROUTINE ED_UnPackBladeMeshInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -3622,8 +3492,8 @@ SUBROUTINE ED_UnPackBladeMeshInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%BldNodes = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%BldNodes = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RNodes not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3637,15 +3507,10 @@ SUBROUTINE ED_UnPackBladeMeshInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RNodes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%RNodes)>0) OutData%RNodes = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RNodes))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RNodes) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%RNodes,1), UBOUND(OutData%RNodes,1) + OutData%RNodes(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AeroTwst not allocated Int_Xferred = Int_Xferred + 1 @@ -3660,15 +3525,10 @@ SUBROUTINE ED_UnPackBladeMeshInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AeroTwst.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%AeroTwst)>0) OutData%AeroTwst = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AeroTwst))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AeroTwst) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AeroTwst,1), UBOUND(OutData%AeroTwst,1) + OutData%AeroTwst(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Chord not allocated Int_Xferred = Int_Xferred + 1 @@ -3683,15 +3543,10 @@ SUBROUTINE ED_UnPackBladeMeshInputData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Chord.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Chord)>0) OutData%Chord = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Chord))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Chord) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Chord,1), UBOUND(OutData%Chord,1) + OutData%Chord(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE ED_UnPackBladeMeshInputData @@ -4116,6 +3971,21 @@ SUBROUTINE ED_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrSt DstInputFileData%TFrlUSDmp = SrcInputFileData%TFrlUSDmp DstInputFileData%TFrlDSDmp = SrcInputFileData%TFrlDSDmp DstInputFileData%method = SrcInputFileData%method + DstInputFileData%BldNd_NumOuts = SrcInputFileData%BldNd_NumOuts +IF (ALLOCATED(SrcInputFileData%BldNd_OutList)) THEN + i1_l = LBOUND(SrcInputFileData%BldNd_OutList,1) + i1_u = UBOUND(SrcInputFileData%BldNd_OutList,1) + IF (.NOT. ALLOCATED(DstInputFileData%BldNd_OutList)) THEN + ALLOCATE(DstInputFileData%BldNd_OutList(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInputFileData%BldNd_OutList.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstInputFileData%BldNd_OutList = SrcInputFileData%BldNd_OutList +ENDIF + DstInputFileData%BldNd_BlOutNd_Str = SrcInputFileData%BldNd_BlOutNd_Str + DstInputFileData%BldNd_BladesOut = SrcInputFileData%BldNd_BladesOut END SUBROUTINE ED_CopyInputFile SUBROUTINE ED_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) @@ -4192,6 +4062,9 @@ SUBROUTINE ED_DestroyInputFile( InputFileData, ErrStat, ErrMsg ) ENDIF IF (ALLOCATED(InputFileData%TwSScgOf)) THEN DEALLOCATE(InputFileData%TwSScgOf) +ENDIF +IF (ALLOCATED(InputFileData%BldNd_OutList)) THEN + DEALLOCATE(InputFileData%BldNd_OutList) ENDIF END SUBROUTINE ED_DestroyInputFile @@ -4525,6 +4398,14 @@ SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Re_BufSz = Re_BufSz + 1 ! TFrlUSDmp Re_BufSz = Re_BufSz + 1 ! TFrlDSDmp Int_BufSz = Int_BufSz + 1 ! method + Int_BufSz = Int_BufSz + 1 ! BldNd_NumOuts + Int_BufSz = Int_BufSz + 1 ! BldNd_OutList allocated yes/no + IF ( ALLOCATED(InData%BldNd_OutList) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! BldNd_OutList upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%BldNd_OutList)*LEN(InData%BldNd_OutList) ! BldNd_OutList + END IF + Int_BufSz = Int_BufSz + 1*LEN(InData%BldNd_BlOutNd_Str) ! BldNd_BlOutNd_Str + Int_BufSz = Int_BufSz + 1 ! BldNd_BladesOut IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -4552,48 +4433,48 @@ SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%FlapDOF1 , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%FlapDOF2 , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%EdgeDOF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TeetDOF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%DrTrDOF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%GenDOF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%YawDOF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TwFADOF1 , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TwFADOF2 , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TwSSDOF1 , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TwSSDOF2 , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmSgDOF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmSwDOF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmHvDOF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmRDOF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmPDOF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmYDOF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%OoPDefl - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%IPDefl - Re_Xferred = Re_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Gravity + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%FlapDOF1, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%FlapDOF2, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%EdgeDOF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TeetDOF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%DrTrDOF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%GenDOF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%YawDOF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TwFADOF1, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TwFADOF2, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TwSSDOF1, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TwSSDOF2, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmSgDOF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmSwDOF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmHvDOF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmRDOF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmPDOF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmYDOF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%OoPDefl + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%IPDefl + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%BlPitch) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4604,39 +4485,41 @@ SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlPitch,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BlPitch)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlPitch))-1 ) = PACK(InData%BlPitch,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlPitch) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TeetDefl - Re_Xferred = Re_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%Azimuth - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RotSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NacYaw - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TTDspFA - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TTDspSS - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmSurge - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmSway - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmHeave - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmRoll - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmPitch - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmYaw - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumBl - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TipRad - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HubRad - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%BlPitch,1), UBOUND(InData%BlPitch,1) + ReKiBuf(Re_Xferred) = InData%BlPitch(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%TeetDefl + Re_Xferred = Re_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%Azimuth + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RotSpeed + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NacYaw + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TTDspFA + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TTDspSS + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmSurge + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmSway + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmHeave + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmRoll + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmPitch + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmYaw + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumBl + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TipRad + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HubRad + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%PreCone) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4647,49 +4530,51 @@ SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PreCone,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PreCone)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PreCone))-1 ) = PACK(InData%PreCone,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PreCone) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HubCM - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%UndSling - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Delta3 - Re_Xferred = Re_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%AzimB1Up - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%OverHang - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ShftGagL - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ShftTilt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NacCMxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NacCMyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NacCMzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NcIMUxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NcIMUyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NcIMUzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Twr2Shft - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TowerHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TowerBsHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmCMxt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmCMyt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmCMzt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmRefzt - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%PreCone,1), UBOUND(InData%PreCone,1) + ReKiBuf(Re_Xferred) = InData%PreCone(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%HubCM + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%UndSling + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Delta3 + Re_Xferred = Re_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%AzimB1Up + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%OverHang + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%ShftGagL + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%ShftTilt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NacCMxn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NacCMyn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NacCMzn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NcIMUxn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NcIMUyn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NcIMUzn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Twr2Shft + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TowerHt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TowerBsHt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmCMxt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmCMyt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmCMzt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmRefzt + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%TipMass) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4700,31 +4585,33 @@ SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TipMass,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TipMass)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TipMass))-1 ) = PACK(InData%TipMass,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TipMass) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HubMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HubIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GenIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NacMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NacYIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawBrMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmRIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmPIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmYIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%BldNodes - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%TipMass,1), UBOUND(InData%TipMass,1) + ReKiBuf(Re_Xferred) = InData%TipMass(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%HubMass + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HubIner + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GenIner + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NacMass + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NacYIner + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawBrMass + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmMass + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmRIner + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmPIner + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmYIner + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%BldNodes + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%InpBlMesh) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4807,58 +4694,62 @@ SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg ENDIF END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TeetMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TeetDmpP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TeetDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TeetCDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TeetSStP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TeetHStP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TeetSSSp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TeetHSSp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GBoxEff - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GBRatio - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DTTorSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DTTorDmp - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Furling , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TwrNodes - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%SumPrint , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%OutFile - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TabDelim , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%Tstart - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DecFact - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NTwGages - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%TwrGagNd))-1 ) = PACK(InData%TwrGagNd,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%TwrGagNd) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NBlGages - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%BldGagNd))-1 ) = PACK(InData%BldGagNd,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%BldGagNd) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TeetMod + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TeetDmpP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TeetDmp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TeetCDmp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TeetSStP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TeetHStP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TeetSSSp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TeetHSSp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GBoxEff + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GBRatio + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DTTorSpr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DTTorDmp + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%Furling, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TwrNodes + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%SumPrint, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%OutFile + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TabDelim, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%OutFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DbKiBuf(Db_Xferred) = InData%Tstart + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DecFact + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NTwGages + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%TwrGagNd,1), UBOUND(InData%TwrGagNd,1) + IntKiBuf(Int_Xferred) = InData%TwrGagNd(i1) + Int_Xferred = Int_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%NBlGages + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%BldGagNd,1), UBOUND(InData%BldGagNd,1) + IntKiBuf(Int_Xferred) = InData%BldGagNd(i1) + Int_Xferred = Int_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%OutList) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4869,23 +4760,31 @@ SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutList,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) + DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) DO I = 1, LEN(InData%OutList) IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NTwInpSt - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwrFADmp))-1 ) = PACK(InData%TwrFADmp,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwrFADmp) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwrSSDmp))-1 ) = PACK(InData%TwrSSDmp,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwrSSDmp) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FAStTunr))-1 ) = PACK(InData%FAStTunr,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FAStTunr) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SSStTunr))-1 ) = PACK(InData%SSStTunr,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SSStTunr) + END DO + END IF + IntKiBuf(Int_Xferred) = InData%NTwInpSt + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%TwrFADmp,1), UBOUND(InData%TwrFADmp,1) + ReKiBuf(Re_Xferred) = InData%TwrFADmp(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%TwrSSDmp,1), UBOUND(InData%TwrSSDmp,1) + ReKiBuf(Re_Xferred) = InData%TwrSSDmp(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%FAStTunr,1), UBOUND(InData%FAStTunr,1) + ReKiBuf(Re_Xferred) = InData%FAStTunr(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%SSStTunr,1), UBOUND(InData%SSStTunr,1) + ReKiBuf(Re_Xferred) = InData%SSStTunr(i1) + Re_Xferred = Re_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%HtFract) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4896,8 +4795,10 @@ SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HtFract,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%HtFract)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%HtFract))-1 ) = PACK(InData%HtFract,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%HtFract) + DO i1 = LBOUND(InData%HtFract,1), UBOUND(InData%HtFract,1) + ReKiBuf(Re_Xferred) = InData%HtFract(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TMassDen) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4909,8 +4810,10 @@ SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TMassDen,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TMassDen)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TMassDen))-1 ) = PACK(InData%TMassDen,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TMassDen) + DO i1 = LBOUND(InData%TMassDen,1), UBOUND(InData%TMassDen,1) + ReKiBuf(Re_Xferred) = InData%TMassDen(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TwFAStif) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4922,8 +4825,10 @@ SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwFAStif,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwFAStif)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwFAStif))-1 ) = PACK(InData%TwFAStif,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwFAStif) + DO i1 = LBOUND(InData%TwFAStif,1), UBOUND(InData%TwFAStif,1) + ReKiBuf(Re_Xferred) = InData%TwFAStif(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TwSSStif) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4935,8 +4840,10 @@ SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwSSStif,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwSSStif)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwSSStif))-1 ) = PACK(InData%TwSSStif,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwSSStif) + DO i1 = LBOUND(InData%TwSSStif,1), UBOUND(InData%TwSSStif,1) + ReKiBuf(Re_Xferred) = InData%TwSSStif(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TwFAM1Sh) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4948,8 +4855,10 @@ SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwFAM1Sh,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwFAM1Sh)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwFAM1Sh))-1 ) = PACK(InData%TwFAM1Sh,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwFAM1Sh) + DO i1 = LBOUND(InData%TwFAM1Sh,1), UBOUND(InData%TwFAM1Sh,1) + ReKiBuf(Re_Xferred) = InData%TwFAM1Sh(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TwFAM2Sh) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4961,8 +4870,10 @@ SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwFAM2Sh,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwFAM2Sh)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwFAM2Sh))-1 ) = PACK(InData%TwFAM2Sh,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwFAM2Sh) + DO i1 = LBOUND(InData%TwFAM2Sh,1), UBOUND(InData%TwFAM2Sh,1) + ReKiBuf(Re_Xferred) = InData%TwFAM2Sh(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TwSSM1Sh) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4974,8 +4885,10 @@ SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwSSM1Sh,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwSSM1Sh)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwSSM1Sh))-1 ) = PACK(InData%TwSSM1Sh,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwSSM1Sh) + DO i1 = LBOUND(InData%TwSSM1Sh,1), UBOUND(InData%TwSSM1Sh,1) + ReKiBuf(Re_Xferred) = InData%TwSSM1Sh(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TwSSM2Sh) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4987,8 +4900,10 @@ SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwSSM2Sh,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwSSM2Sh)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwSSM2Sh))-1 ) = PACK(InData%TwSSM2Sh,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwSSM2Sh) + DO i1 = LBOUND(InData%TwSSM2Sh,1), UBOUND(InData%TwSSM2Sh,1) + ReKiBuf(Re_Xferred) = InData%TwSSM2Sh(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TwGJStif) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5000,8 +4915,10 @@ SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwGJStif,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwGJStif)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwGJStif))-1 ) = PACK(InData%TwGJStif,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwGJStif) + DO i1 = LBOUND(InData%TwGJStif,1), UBOUND(InData%TwGJStif,1) + ReKiBuf(Re_Xferred) = InData%TwGJStif(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TwEAStif) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5013,8 +4930,10 @@ SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwEAStif,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwEAStif)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwEAStif))-1 ) = PACK(InData%TwEAStif,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwEAStif) + DO i1 = LBOUND(InData%TwEAStif,1), UBOUND(InData%TwEAStif,1) + ReKiBuf(Re_Xferred) = InData%TwEAStif(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TwFAIner) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5026,8 +4945,10 @@ SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwFAIner,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwFAIner)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwFAIner))-1 ) = PACK(InData%TwFAIner,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwFAIner) + DO i1 = LBOUND(InData%TwFAIner,1), UBOUND(InData%TwFAIner,1) + ReKiBuf(Re_Xferred) = InData%TwFAIner(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TwSSIner) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5039,8 +4960,10 @@ SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwSSIner,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwSSIner)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwSSIner))-1 ) = PACK(InData%TwSSIner,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwSSIner) + DO i1 = LBOUND(InData%TwSSIner,1), UBOUND(InData%TwSSIner,1) + ReKiBuf(Re_Xferred) = InData%TwSSIner(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TwFAcgOf) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5052,8 +4975,10 @@ SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwFAcgOf,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwFAcgOf)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwFAcgOf))-1 ) = PACK(InData%TwFAcgOf,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwFAcgOf) + DO i1 = LBOUND(InData%TwFAcgOf,1), UBOUND(InData%TwFAcgOf,1) + ReKiBuf(Re_Xferred) = InData%TwFAcgOf(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TwSScgOf) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5065,131 +4990,158 @@ SUBROUTINE ED_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwSScgOf,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwSScgOf)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwSScgOf))-1 ) = PACK(InData%TwSScgOf,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwSScgOf) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%RFrlDOF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TFrlDOF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RotFurl - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TailFurl - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Yaw2Shft - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ShftSkew - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlCMxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlCMyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlCMzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%BoomCMxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%BoomCMyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%BoomCMzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFinCMxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFinCMyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFinCMzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFinCPxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFinCPyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFinCPzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFinSkew - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFinTilt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFinBank - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlPntxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlPntyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlPntzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlSkew - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlTilt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlPntxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlPntyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlPntzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlSkew - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlTilt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%BoomMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFinMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlIner - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%RFrlMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlCDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlUSSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlDSSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlUSSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlDSSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlUSDP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlDSDP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlUSDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlDSDmp - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TFrlMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlCDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlUSSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlDSSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlUSSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlDSSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlUSDP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlDSDP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlUSDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlDSDmp - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%method - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%TwSScgOf,1), UBOUND(InData%TwSScgOf,1) + ReKiBuf(Re_Xferred) = InData%TwSScgOf(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IntKiBuf(Int_Xferred) = TRANSFER(InData%RFrlDOF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TFrlDOF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RotFurl + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TailFurl + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Yaw2Shft + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%ShftSkew + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlCMxn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlCMyn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlCMzn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%BoomCMxn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%BoomCMyn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%BoomCMzn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFinCMxn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFinCMyn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFinCMzn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFinCPxn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFinCPyn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFinCPzn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFinSkew + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFinTilt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFinBank + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlPntxn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlPntyn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlPntzn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlSkew + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlTilt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlPntxn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlPntyn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlPntzn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlSkew + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlTilt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlMass + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%BoomMass + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFinMass + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlIner + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlIner + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%RFrlMod + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlSpr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlDmp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlCDmp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlUSSP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlDSSP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlUSSpr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlDSSpr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlUSDP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlDSDP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlUSDmp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlDSDmp + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TFrlMod + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlSpr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlDmp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlCDmp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlUSSP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlDSSP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlUSSpr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlDSSpr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlUSDP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlDSDP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlUSDmp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlDSDmp + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%method + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%BldNd_NumOuts + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%BldNd_OutList) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BldNd_OutList,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldNd_OutList,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%BldNd_OutList,1), UBOUND(InData%BldNd_OutList,1) + DO I = 1, LEN(InData%BldNd_OutList) + IntKiBuf(Int_Xferred) = ICHAR(InData%BldNd_OutList(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + DO I = 1, LEN(InData%BldNd_BlOutNd_Str) + IntKiBuf(Int_Xferred) = ICHAR(InData%BldNd_BlOutNd_Str(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%BldNd_BladesOut + Int_Xferred = Int_Xferred + 1 END SUBROUTINE ED_PackInputFile SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -5205,12 +5157,6 @@ SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -5225,48 +5171,48 @@ SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%Gravity = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%FlapDOF1 = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%FlapDOF2 = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%EdgeDOF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%TeetDOF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%DrTrDOF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%GenDOF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%YawDOF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%TwFADOF1 = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%TwFADOF2 = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%TwSSDOF1 = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%TwSSDOF2 = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmSgDOF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmSwDOF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmHvDOF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmRDOF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmPDOF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmYDOF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%OoPDefl = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%IPDefl = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%Gravity = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%FlapDOF1 = TRANSFER(IntKiBuf(Int_Xferred), OutData%FlapDOF1) + Int_Xferred = Int_Xferred + 1 + OutData%FlapDOF2 = TRANSFER(IntKiBuf(Int_Xferred), OutData%FlapDOF2) + Int_Xferred = Int_Xferred + 1 + OutData%EdgeDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%EdgeDOF) + Int_Xferred = Int_Xferred + 1 + OutData%TeetDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%TeetDOF) + Int_Xferred = Int_Xferred + 1 + OutData%DrTrDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%DrTrDOF) + Int_Xferred = Int_Xferred + 1 + OutData%GenDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%GenDOF) + Int_Xferred = Int_Xferred + 1 + OutData%YawDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%YawDOF) + Int_Xferred = Int_Xferred + 1 + OutData%TwFADOF1 = TRANSFER(IntKiBuf(Int_Xferred), OutData%TwFADOF1) + Int_Xferred = Int_Xferred + 1 + OutData%TwFADOF2 = TRANSFER(IntKiBuf(Int_Xferred), OutData%TwFADOF2) + Int_Xferred = Int_Xferred + 1 + OutData%TwSSDOF1 = TRANSFER(IntKiBuf(Int_Xferred), OutData%TwSSDOF1) + Int_Xferred = Int_Xferred + 1 + OutData%TwSSDOF2 = TRANSFER(IntKiBuf(Int_Xferred), OutData%TwSSDOF2) + Int_Xferred = Int_Xferred + 1 + OutData%PtfmSgDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmSgDOF) + Int_Xferred = Int_Xferred + 1 + OutData%PtfmSwDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmSwDOF) + Int_Xferred = Int_Xferred + 1 + OutData%PtfmHvDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmHvDOF) + Int_Xferred = Int_Xferred + 1 + OutData%PtfmRDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmRDOF) + Int_Xferred = Int_Xferred + 1 + OutData%PtfmPDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmPDOF) + Int_Xferred = Int_Xferred + 1 + OutData%PtfmYDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmYDOF) + Int_Xferred = Int_Xferred + 1 + OutData%OoPDefl = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%IPDefl = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlPitch not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5280,46 +5226,41 @@ SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitch.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BlPitch)>0) OutData%BlPitch = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlPitch))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlPitch) - DEALLOCATE(mask1) - END IF - OutData%TeetDefl = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Azimuth = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%RotSpeed = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NacYaw = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TTDspFA = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TTDspSS = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmSurge = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmSway = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmHeave = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmRoll = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmPitch = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmYaw = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NumBl = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TipRad = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HubRad = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%BlPitch,1), UBOUND(OutData%BlPitch,1) + OutData%BlPitch(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%TeetDefl = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Azimuth = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%RotSpeed = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NacYaw = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TTDspFA = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TTDspSS = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmSurge = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmSway = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmHeave = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmRoll = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmPitch = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmYaw = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NumBl = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TipRad = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HubRad = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PreCone not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5333,56 +5274,51 @@ SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PreCone.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%PreCone)>0) OutData%PreCone = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PreCone))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PreCone) - DEALLOCATE(mask1) - END IF - OutData%HubCM = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%UndSling = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Delta3 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%AzimB1Up = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%OverHang = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%ShftGagL = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%ShftTilt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NacCMxn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NacCMyn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NacCMzn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NcIMUxn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NcIMUyn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NcIMUzn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Twr2Shft = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TowerHt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TowerBsHt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmCMxt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmCMyt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmCMzt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmRefzt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%PreCone,1), UBOUND(OutData%PreCone,1) + OutData%PreCone(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%HubCM = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%UndSling = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Delta3 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%AzimB1Up = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%OverHang = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%ShftGagL = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%ShftTilt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NacCMxn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NacCMyn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NacCMzn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NcIMUxn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NcIMUyn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NcIMUzn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Twr2Shft = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TowerHt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TowerBsHt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmCMxt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmCMyt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmCMzt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmRefzt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TipMass not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5396,38 +5332,33 @@ SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TipMass.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TipMass)>0) OutData%TipMass = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TipMass))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TipMass) - DEALLOCATE(mask1) - END IF - OutData%HubMass = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HubIner = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GenIner = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NacMass = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NacYIner = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawBrMass = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmMass = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmRIner = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmPIner = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmYIner = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%BldNodes = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%TipMass,1), UBOUND(OutData%TipMass,1) + OutData%TipMass(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%HubMass = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HubIner = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GenIner = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NacMass = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NacYIner = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawBrMass = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmMass = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmRIner = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmPIner = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmYIner = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%BldNodes = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InpBlMesh not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5540,76 +5471,66 @@ SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%TeetMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TeetDmpP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TeetDmp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TeetCDmp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TeetSStP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TeetHStP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TeetSSSp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TeetHSSp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GBoxEff = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GBRatio = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%DTTorSpr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%DTTorDmp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Furling = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%TwrNodes = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%SumPrint = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%OutFile = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TabDelim = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutFmt) - OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%Tstart = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%DecFact = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NTwGages = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%TeetMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TeetDmpP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TeetDmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TeetCDmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TeetSStP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TeetHStP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TeetSSSp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TeetHSSp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GBoxEff = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GBRatio = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%DTTorSpr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%DTTorDmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Furling = TRANSFER(IntKiBuf(Int_Xferred), OutData%Furling) + Int_Xferred = Int_Xferred + 1 + OutData%TwrNodes = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%SumPrint = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumPrint) + Int_Xferred = Int_Xferred + 1 + OutData%OutFile = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TabDelim = TRANSFER(IntKiBuf(Int_Xferred), OutData%TabDelim) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%OutFmt) + OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%Tstart = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%DecFact = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NTwGages = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%TwrGagNd,1) i1_u = UBOUND(OutData%TwrGagNd,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%TwrGagNd = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%TwrGagNd))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%TwrGagNd) - DEALLOCATE(mask1) - OutData%NBlGages = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%TwrGagNd,1), UBOUND(OutData%TwrGagNd,1) + OutData%TwrGagNd(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + OutData%NBlGages = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%BldGagNd,1) i1_u = UBOUND(OutData%BldGagNd,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%BldGagNd = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%BldGagNd))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%BldGagNd) - DEALLOCATE(mask1) - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%BldGagNd,1), UBOUND(OutData%BldGagNd,1) + OutData%BldGagNd(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutList not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5623,66 +5544,39 @@ SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) + DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) DO I = 1, LEN(OutData%OutList) OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF - OutData%NTwInpSt = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NTwInpSt = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%TwrFADmp,1) i1_u = UBOUND(OutData%TwrFADmp,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%TwrFADmp = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwrFADmp))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwrFADmp) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwrFADmp,1), UBOUND(OutData%TwrFADmp,1) + OutData%TwrFADmp(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%TwrSSDmp,1) i1_u = UBOUND(OutData%TwrSSDmp,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%TwrSSDmp = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwrSSDmp))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwrSSDmp) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwrSSDmp,1), UBOUND(OutData%TwrSSDmp,1) + OutData%TwrSSDmp(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%FAStTunr,1) i1_u = UBOUND(OutData%FAStTunr,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%FAStTunr = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FAStTunr))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FAStTunr) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FAStTunr,1), UBOUND(OutData%FAStTunr,1) + OutData%FAStTunr(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%SSStTunr,1) i1_u = UBOUND(OutData%SSStTunr,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%SSStTunr = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SSStTunr))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SSStTunr) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%SSStTunr,1), UBOUND(OutData%SSStTunr,1) + OutData%SSStTunr(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! HtFract not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5696,15 +5590,10 @@ SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%HtFract.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%HtFract)>0) OutData%HtFract = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%HtFract))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%HtFract) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%HtFract,1), UBOUND(OutData%HtFract,1) + OutData%HtFract(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TMassDen not allocated Int_Xferred = Int_Xferred + 1 @@ -5719,15 +5608,10 @@ SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TMassDen.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TMassDen)>0) OutData%TMassDen = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TMassDen))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TMassDen) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TMassDen,1), UBOUND(OutData%TMassDen,1) + OutData%TMassDen(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwFAStif not allocated Int_Xferred = Int_Xferred + 1 @@ -5742,15 +5626,10 @@ SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwFAStif.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwFAStif)>0) OutData%TwFAStif = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwFAStif))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwFAStif) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwFAStif,1), UBOUND(OutData%TwFAStif,1) + OutData%TwFAStif(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwSSStif not allocated Int_Xferred = Int_Xferred + 1 @@ -5765,15 +5644,10 @@ SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwSSStif.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwSSStif)>0) OutData%TwSSStif = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwSSStif))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwSSStif) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwSSStif,1), UBOUND(OutData%TwSSStif,1) + OutData%TwSSStif(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwFAM1Sh not allocated Int_Xferred = Int_Xferred + 1 @@ -5788,15 +5662,10 @@ SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwFAM1Sh.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwFAM1Sh)>0) OutData%TwFAM1Sh = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwFAM1Sh))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwFAM1Sh) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwFAM1Sh,1), UBOUND(OutData%TwFAM1Sh,1) + OutData%TwFAM1Sh(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwFAM2Sh not allocated Int_Xferred = Int_Xferred + 1 @@ -5811,15 +5680,10 @@ SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwFAM2Sh.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwFAM2Sh)>0) OutData%TwFAM2Sh = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwFAM2Sh))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwFAM2Sh) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwFAM2Sh,1), UBOUND(OutData%TwFAM2Sh,1) + OutData%TwFAM2Sh(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwSSM1Sh not allocated Int_Xferred = Int_Xferred + 1 @@ -5834,15 +5698,10 @@ SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwSSM1Sh.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwSSM1Sh)>0) OutData%TwSSM1Sh = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwSSM1Sh))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwSSM1Sh) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwSSM1Sh,1), UBOUND(OutData%TwSSM1Sh,1) + OutData%TwSSM1Sh(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwSSM2Sh not allocated Int_Xferred = Int_Xferred + 1 @@ -5857,15 +5716,10 @@ SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwSSM2Sh.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwSSM2Sh)>0) OutData%TwSSM2Sh = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwSSM2Sh))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwSSM2Sh) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwSSM2Sh,1), UBOUND(OutData%TwSSM2Sh,1) + OutData%TwSSM2Sh(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwGJStif not allocated Int_Xferred = Int_Xferred + 1 @@ -5880,15 +5734,10 @@ SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwGJStif.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwGJStif)>0) OutData%TwGJStif = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwGJStif))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwGJStif) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwGJStif,1), UBOUND(OutData%TwGJStif,1) + OutData%TwGJStif(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwEAStif not allocated Int_Xferred = Int_Xferred + 1 @@ -5903,15 +5752,10 @@ SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwEAStif.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwEAStif)>0) OutData%TwEAStif = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwEAStif))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwEAStif) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwEAStif,1), UBOUND(OutData%TwEAStif,1) + OutData%TwEAStif(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwFAIner not allocated Int_Xferred = Int_Xferred + 1 @@ -5926,15 +5770,10 @@ SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwFAIner.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwFAIner)>0) OutData%TwFAIner = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwFAIner))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwFAIner) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwFAIner,1), UBOUND(OutData%TwFAIner,1) + OutData%TwFAIner(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwSSIner not allocated Int_Xferred = Int_Xferred + 1 @@ -5949,15 +5788,10 @@ SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwSSIner.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwSSIner)>0) OutData%TwSSIner = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwSSIner))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwSSIner) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwSSIner,1), UBOUND(OutData%TwSSIner,1) + OutData%TwSSIner(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwFAcgOf not allocated Int_Xferred = Int_Xferred + 1 @@ -5972,15 +5806,10 @@ SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwFAcgOf.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwFAcgOf)>0) OutData%TwFAcgOf = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwFAcgOf))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwFAcgOf) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TwFAcgOf,1), UBOUND(OutData%TwFAcgOf,1) + OutData%TwFAcgOf(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwSScgOf not allocated Int_Xferred = Int_Xferred + 1 @@ -5995,138 +5824,161 @@ SUBROUTINE ED_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwSScgOf.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TwSScgOf)>0) OutData%TwSScgOf = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwSScgOf))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwSScgOf) - DEALLOCATE(mask1) - END IF - OutData%RFrlDOF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%TFrlDOF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%RotFurl = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TailFurl = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Yaw2Shft = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%ShftSkew = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlCMxn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlCMyn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlCMzn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%BoomCMxn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%BoomCMyn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%BoomCMzn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFinCMxn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFinCMyn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFinCMzn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFinCPxn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFinCPyn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFinCPzn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFinSkew = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFinTilt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFinBank = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlPntxn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlPntyn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlPntzn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlSkew = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlTilt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlPntxn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlPntyn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlPntzn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlSkew = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlTilt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlMass = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%BoomMass = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFinMass = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlIner = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlIner = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%RFrlSpr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlDmp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlCDmp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlUSSP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlDSSP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlUSSpr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlDSSpr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlUSDP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlDSDP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlUSDmp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlDSDmp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TFrlSpr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlDmp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlCDmp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlUSSP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlDSSP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlUSSpr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlDSSpr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlUSDP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlDSDP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlUSDmp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlDSDmp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%method = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%TwSScgOf,1), UBOUND(OutData%TwSScgOf,1) + OutData%TwSScgOf(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%RFrlDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%RFrlDOF) + Int_Xferred = Int_Xferred + 1 + OutData%TFrlDOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%TFrlDOF) + Int_Xferred = Int_Xferred + 1 + OutData%RotFurl = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TailFurl = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Yaw2Shft = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%ShftSkew = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlCMxn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlCMyn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlCMzn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%BoomCMxn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%BoomCMyn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%BoomCMzn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFinCMxn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFinCMyn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFinCMzn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFinCPxn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFinCPyn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFinCPzn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFinSkew = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFinTilt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFinBank = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlPntxn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlPntyn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlPntzn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlSkew = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlTilt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlPntxn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlPntyn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlPntzn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlSkew = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlTilt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlMass = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%BoomMass = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFinMass = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlIner = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlIner = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%RFrlSpr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlDmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlCDmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlUSSP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlDSSP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlUSSpr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlDSSpr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlUSDP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlDSDP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlUSDmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlDSDmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TFrlSpr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlDmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlCDmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlUSSP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlDSSP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlUSSpr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlDSSpr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlUSDP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlDSDP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlUSDmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlDSDmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%method = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%BldNd_NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldNd_OutList not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BldNd_OutList)) DEALLOCATE(OutData%BldNd_OutList) + ALLOCATE(OutData%BldNd_OutList(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_OutList.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%BldNd_OutList,1), UBOUND(OutData%BldNd_OutList,1) + DO I = 1, LEN(OutData%BldNd_OutList) + OutData%BldNd_OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + DO I = 1, LEN(OutData%BldNd_BlOutNd_Str) + OutData%BldNd_BlOutNd_Str(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%BldNd_BladesOut = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE ED_UnPackInputFile SUBROUTINE ED_CopyCoordSys( SrcCoordSysData, DstCoordSysData, CtrlCode, ErrStat, ErrMsg ) @@ -6705,48 +6557,90 @@ SUBROUTINE ED_PackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%a1))-1 ) = PACK(InData%a1,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%a1) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%a2))-1 ) = PACK(InData%a2,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%a2) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%a3))-1 ) = PACK(InData%a3,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%a3) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%b1))-1 ) = PACK(InData%b1,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%b1) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%b2))-1 ) = PACK(InData%b2,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%b2) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%b3))-1 ) = PACK(InData%b3,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%b3) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%c1))-1 ) = PACK(InData%c1,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%c1) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%c2))-1 ) = PACK(InData%c2,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%c2) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%c3))-1 ) = PACK(InData%c3,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%c3) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%d1))-1 ) = PACK(InData%d1,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%d1) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%d2))-1 ) = PACK(InData%d2,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%d2) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%d3))-1 ) = PACK(InData%d3,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%d3) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%e1))-1 ) = PACK(InData%e1,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%e1) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%e2))-1 ) = PACK(InData%e2,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%e2) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%e3))-1 ) = PACK(InData%e3,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%e3) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%f1))-1 ) = PACK(InData%f1,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%f1) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%f2))-1 ) = PACK(InData%f2,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%f2) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%f3))-1 ) = PACK(InData%f3,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%f3) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%g1))-1 ) = PACK(InData%g1,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%g1) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%g2))-1 ) = PACK(InData%g2,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%g2) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%g3))-1 ) = PACK(InData%g3,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%g3) + DO i1 = LBOUND(InData%a1,1), UBOUND(InData%a1,1) + DbKiBuf(Db_Xferred) = InData%a1(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%a2,1), UBOUND(InData%a2,1) + DbKiBuf(Db_Xferred) = InData%a2(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%a3,1), UBOUND(InData%a3,1) + DbKiBuf(Db_Xferred) = InData%a3(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%b1,1), UBOUND(InData%b1,1) + DbKiBuf(Db_Xferred) = InData%b1(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%b2,1), UBOUND(InData%b2,1) + DbKiBuf(Db_Xferred) = InData%b2(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%b3,1), UBOUND(InData%b3,1) + DbKiBuf(Db_Xferred) = InData%b3(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%c1,1), UBOUND(InData%c1,1) + DbKiBuf(Db_Xferred) = InData%c1(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%c2,1), UBOUND(InData%c2,1) + DbKiBuf(Db_Xferred) = InData%c2(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%c3,1), UBOUND(InData%c3,1) + DbKiBuf(Db_Xferred) = InData%c3(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%d1,1), UBOUND(InData%d1,1) + DbKiBuf(Db_Xferred) = InData%d1(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%d2,1), UBOUND(InData%d2,1) + DbKiBuf(Db_Xferred) = InData%d2(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%d3,1), UBOUND(InData%d3,1) + DbKiBuf(Db_Xferred) = InData%d3(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%e1,1), UBOUND(InData%e1,1) + DbKiBuf(Db_Xferred) = InData%e1(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%e2,1), UBOUND(InData%e2,1) + DbKiBuf(Db_Xferred) = InData%e2(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%e3,1), UBOUND(InData%e3,1) + DbKiBuf(Db_Xferred) = InData%e3(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%f1,1), UBOUND(InData%f1,1) + DbKiBuf(Db_Xferred) = InData%f1(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%f2,1), UBOUND(InData%f2,1) + DbKiBuf(Db_Xferred) = InData%f2(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%f3,1), UBOUND(InData%f3,1) + DbKiBuf(Db_Xferred) = InData%f3(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%g1,1), UBOUND(InData%g1,1) + DbKiBuf(Db_Xferred) = InData%g1(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%g2,1), UBOUND(InData%g2,1) + DbKiBuf(Db_Xferred) = InData%g2(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%g3,1), UBOUND(InData%g3,1) + DbKiBuf(Db_Xferred) = InData%g3(i1) + Db_Xferred = Db_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%i1) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -6760,8 +6654,12 @@ SUBROUTINE ED_PackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%i1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%i1)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%i1))-1 ) = PACK(InData%i1,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%i1) + DO i2 = LBOUND(InData%i1,2), UBOUND(InData%i1,2) + DO i1 = LBOUND(InData%i1,1), UBOUND(InData%i1,1) + DbKiBuf(Db_Xferred) = InData%i1(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%i2) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6776,8 +6674,12 @@ SUBROUTINE ED_PackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%i2,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%i2)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%i2))-1 ) = PACK(InData%i2,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%i2) + DO i2 = LBOUND(InData%i2,2), UBOUND(InData%i2,2) + DO i1 = LBOUND(InData%i2,1), UBOUND(InData%i2,1) + DbKiBuf(Db_Xferred) = InData%i2(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%i3) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6792,8 +6694,12 @@ SUBROUTINE ED_PackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%i3,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%i3)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%i3))-1 ) = PACK(InData%i3,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%i3) + DO i2 = LBOUND(InData%i3,2), UBOUND(InData%i3,2) + DO i1 = LBOUND(InData%i3,1), UBOUND(InData%i3,1) + DbKiBuf(Db_Xferred) = InData%i3(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%j1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6808,8 +6714,12 @@ SUBROUTINE ED_PackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%j1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%j1)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%j1))-1 ) = PACK(InData%j1,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%j1) + DO i2 = LBOUND(InData%j1,2), UBOUND(InData%j1,2) + DO i1 = LBOUND(InData%j1,1), UBOUND(InData%j1,1) + DbKiBuf(Db_Xferred) = InData%j1(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%j2) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6824,8 +6734,12 @@ SUBROUTINE ED_PackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%j2,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%j2)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%j2))-1 ) = PACK(InData%j2,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%j2) + DO i2 = LBOUND(InData%j2,2), UBOUND(InData%j2,2) + DO i1 = LBOUND(InData%j2,1), UBOUND(InData%j2,1) + DbKiBuf(Db_Xferred) = InData%j2(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%j3) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6840,8 +6754,12 @@ SUBROUTINE ED_PackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%j3,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%j3)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%j3))-1 ) = PACK(InData%j3,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%j3) + DO i2 = LBOUND(InData%j3,2), UBOUND(InData%j3,2) + DO i1 = LBOUND(InData%j3,1), UBOUND(InData%j3,1) + DbKiBuf(Db_Xferred) = InData%j3(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%m1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6859,8 +6777,14 @@ SUBROUTINE ED_PackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%m1,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%m1)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%m1))-1 ) = PACK(InData%m1,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%m1) + DO i3 = LBOUND(InData%m1,3), UBOUND(InData%m1,3) + DO i2 = LBOUND(InData%m1,2), UBOUND(InData%m1,2) + DO i1 = LBOUND(InData%m1,1), UBOUND(InData%m1,1) + DbKiBuf(Db_Xferred) = InData%m1(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%m2) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6878,8 +6802,14 @@ SUBROUTINE ED_PackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%m2,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%m2)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%m2))-1 ) = PACK(InData%m2,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%m2) + DO i3 = LBOUND(InData%m2,3), UBOUND(InData%m2,3) + DO i2 = LBOUND(InData%m2,2), UBOUND(InData%m2,2) + DO i1 = LBOUND(InData%m2,1), UBOUND(InData%m2,1) + DbKiBuf(Db_Xferred) = InData%m2(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%m3) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6897,8 +6827,14 @@ SUBROUTINE ED_PackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%m3,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%m3)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%m3))-1 ) = PACK(InData%m3,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%m3) + DO i3 = LBOUND(InData%m3,3), UBOUND(InData%m3,3) + DO i2 = LBOUND(InData%m3,2), UBOUND(InData%m3,2) + DO i1 = LBOUND(InData%m3,1), UBOUND(InData%m3,1) + DbKiBuf(Db_Xferred) = InData%m3(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%n1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6916,8 +6852,14 @@ SUBROUTINE ED_PackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%n1,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%n1)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%n1))-1 ) = PACK(InData%n1,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%n1) + DO i3 = LBOUND(InData%n1,3), UBOUND(InData%n1,3) + DO i2 = LBOUND(InData%n1,2), UBOUND(InData%n1,2) + DO i1 = LBOUND(InData%n1,1), UBOUND(InData%n1,1) + DbKiBuf(Db_Xferred) = InData%n1(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%n2) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6935,8 +6877,14 @@ SUBROUTINE ED_PackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%n2,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%n2)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%n2))-1 ) = PACK(InData%n2,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%n2) + DO i3 = LBOUND(InData%n2,3), UBOUND(InData%n2,3) + DO i2 = LBOUND(InData%n2,2), UBOUND(InData%n2,2) + DO i1 = LBOUND(InData%n2,1), UBOUND(InData%n2,1) + DbKiBuf(Db_Xferred) = InData%n2(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%n3) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6954,23 +6902,43 @@ SUBROUTINE ED_PackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%n3,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%n3)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%n3))-1 ) = PACK(InData%n3,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%n3) - END IF - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%p1))-1 ) = PACK(InData%p1,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%p1) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%p2))-1 ) = PACK(InData%p2,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%p2) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%p3))-1 ) = PACK(InData%p3,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%p3) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rf1))-1 ) = PACK(InData%rf1,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rf1) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rf2))-1 ) = PACK(InData%rf2,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rf2) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rf3))-1 ) = PACK(InData%rf3,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rf3) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rfa))-1 ) = PACK(InData%rfa,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rfa) + DO i3 = LBOUND(InData%n3,3), UBOUND(InData%n3,3) + DO i2 = LBOUND(InData%n3,2), UBOUND(InData%n3,2) + DO i1 = LBOUND(InData%n3,1), UBOUND(InData%n3,1) + DbKiBuf(Db_Xferred) = InData%n3(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END IF + DO i1 = LBOUND(InData%p1,1), UBOUND(InData%p1,1) + DbKiBuf(Db_Xferred) = InData%p1(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%p2,1), UBOUND(InData%p2,1) + DbKiBuf(Db_Xferred) = InData%p2(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%p3,1), UBOUND(InData%p3,1) + DbKiBuf(Db_Xferred) = InData%p3(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%rf1,1), UBOUND(InData%rf1,1) + DbKiBuf(Db_Xferred) = InData%rf1(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%rf2,1), UBOUND(InData%rf2,1) + DbKiBuf(Db_Xferred) = InData%rf2(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%rf3,1), UBOUND(InData%rf3,1) + DbKiBuf(Db_Xferred) = InData%rf3(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%rfa,1), UBOUND(InData%rfa,1) + DbKiBuf(Db_Xferred) = InData%rfa(i1) + Db_Xferred = Db_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%t1) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -6984,8 +6952,12 @@ SUBROUTINE ED_PackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%t1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%t1)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%t1))-1 ) = PACK(InData%t1,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%t1) + DO i2 = LBOUND(InData%t1,2), UBOUND(InData%t1,2) + DO i1 = LBOUND(InData%t1,1), UBOUND(InData%t1,1) + DbKiBuf(Db_Xferred) = InData%t1(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%t2) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7000,8 +6972,12 @@ SUBROUTINE ED_PackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%t2,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%t2)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%t2))-1 ) = PACK(InData%t2,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%t2) + DO i2 = LBOUND(InData%t2,2), UBOUND(InData%t2,2) + DO i1 = LBOUND(InData%t2,1), UBOUND(InData%t2,1) + DbKiBuf(Db_Xferred) = InData%t2(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%t3) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7016,8 +6992,12 @@ SUBROUTINE ED_PackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%t3,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%t3)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%t3))-1 ) = PACK(InData%t3,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%t3) + DO i2 = LBOUND(InData%t3,2), UBOUND(InData%t3,2) + DO i1 = LBOUND(InData%t3,1), UBOUND(InData%t3,1) + DbKiBuf(Db_Xferred) = InData%t3(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%te1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7035,8 +7015,14 @@ SUBROUTINE ED_PackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%te1,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%te1)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%te1))-1 ) = PACK(InData%te1,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%te1) + DO i3 = LBOUND(InData%te1,3), UBOUND(InData%te1,3) + DO i2 = LBOUND(InData%te1,2), UBOUND(InData%te1,2) + DO i1 = LBOUND(InData%te1,1), UBOUND(InData%te1,1) + DbKiBuf(Db_Xferred) = InData%te1(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%te2) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7054,8 +7040,14 @@ SUBROUTINE ED_PackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%te2,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%te2)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%te2))-1 ) = PACK(InData%te2,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%te2) + DO i3 = LBOUND(InData%te2,3), UBOUND(InData%te2,3) + DO i2 = LBOUND(InData%te2,2), UBOUND(InData%te2,2) + DO i1 = LBOUND(InData%te2,1), UBOUND(InData%te2,1) + DbKiBuf(Db_Xferred) = InData%te2(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%te3) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7073,23 +7065,43 @@ SUBROUTINE ED_PackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%te3,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%te3)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%te3))-1 ) = PACK(InData%te3,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%te3) - END IF - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%tf1))-1 ) = PACK(InData%tf1,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%tf1) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%tf2))-1 ) = PACK(InData%tf2,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%tf2) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%tf3))-1 ) = PACK(InData%tf3,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%tf3) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%tfa))-1 ) = PACK(InData%tfa,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%tfa) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%z1))-1 ) = PACK(InData%z1,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%z1) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%z2))-1 ) = PACK(InData%z2,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%z2) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%z3))-1 ) = PACK(InData%z3,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%z3) + DO i3 = LBOUND(InData%te3,3), UBOUND(InData%te3,3) + DO i2 = LBOUND(InData%te3,2), UBOUND(InData%te3,2) + DO i1 = LBOUND(InData%te3,1), UBOUND(InData%te3,1) + DbKiBuf(Db_Xferred) = InData%te3(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END IF + DO i1 = LBOUND(InData%tf1,1), UBOUND(InData%tf1,1) + DbKiBuf(Db_Xferred) = InData%tf1(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%tf2,1), UBOUND(InData%tf2,1) + DbKiBuf(Db_Xferred) = InData%tf2(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%tf3,1), UBOUND(InData%tf3,1) + DbKiBuf(Db_Xferred) = InData%tf3(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%tfa,1), UBOUND(InData%tfa,1) + DbKiBuf(Db_Xferred) = InData%tfa(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%z1,1), UBOUND(InData%z1,1) + DbKiBuf(Db_Xferred) = InData%z1(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%z2,1), UBOUND(InData%z2,1) + DbKiBuf(Db_Xferred) = InData%z2(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%z3,1), UBOUND(InData%z3,1) + DbKiBuf(Db_Xferred) = InData%z3(i1) + Db_Xferred = Db_Xferred + 1 + END DO END SUBROUTINE ED_PackCoordSys SUBROUTINE ED_UnPackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -7105,12 +7117,6 @@ SUBROUTINE ED_UnPackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (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 @@ -7129,235 +7135,130 @@ SUBROUTINE ED_UnPackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM Int_Xferred = 1 i1_l = LBOUND(OutData%a1,1) i1_u = UBOUND(OutData%a1,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%a1 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%a1))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%a1) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%a1,1), UBOUND(OutData%a1,1) + OutData%a1(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%a2,1) i1_u = UBOUND(OutData%a2,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%a2 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%a2))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%a2) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%a2,1), UBOUND(OutData%a2,1) + OutData%a2(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%a3,1) i1_u = UBOUND(OutData%a3,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%a3 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%a3))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%a3) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%a3,1), UBOUND(OutData%a3,1) + OutData%a3(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%b1,1) i1_u = UBOUND(OutData%b1,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%b1 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%b1))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%b1) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%b1,1), UBOUND(OutData%b1,1) + OutData%b1(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%b2,1) i1_u = UBOUND(OutData%b2,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%b2 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%b2))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%b2) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%b2,1), UBOUND(OutData%b2,1) + OutData%b2(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%b3,1) i1_u = UBOUND(OutData%b3,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%b3 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%b3))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%b3) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%b3,1), UBOUND(OutData%b3,1) + OutData%b3(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%c1,1) i1_u = UBOUND(OutData%c1,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%c1 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%c1))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%c1) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%c1,1), UBOUND(OutData%c1,1) + OutData%c1(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%c2,1) i1_u = UBOUND(OutData%c2,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%c2 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%c2))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%c2) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%c2,1), UBOUND(OutData%c2,1) + OutData%c2(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%c3,1) i1_u = UBOUND(OutData%c3,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%c3 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%c3))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%c3) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%c3,1), UBOUND(OutData%c3,1) + OutData%c3(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%d1,1) i1_u = UBOUND(OutData%d1,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%d1 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%d1))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%d1) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%d1,1), UBOUND(OutData%d1,1) + OutData%d1(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%d2,1) i1_u = UBOUND(OutData%d2,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%d2 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%d2))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%d2) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%d2,1), UBOUND(OutData%d2,1) + OutData%d2(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%d3,1) i1_u = UBOUND(OutData%d3,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%d3 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%d3))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%d3) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%d3,1), UBOUND(OutData%d3,1) + OutData%d3(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%e1,1) i1_u = UBOUND(OutData%e1,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%e1 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%e1))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%e1) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%e1,1), UBOUND(OutData%e1,1) + OutData%e1(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%e2,1) i1_u = UBOUND(OutData%e2,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%e2 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%e2))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%e2) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%e2,1), UBOUND(OutData%e2,1) + OutData%e2(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%e3,1) i1_u = UBOUND(OutData%e3,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%e3 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%e3))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%e3) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%e3,1), UBOUND(OutData%e3,1) + OutData%e3(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%f1,1) i1_u = UBOUND(OutData%f1,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%f1 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%f1))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%f1) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%f1,1), UBOUND(OutData%f1,1) + OutData%f1(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%f2,1) i1_u = UBOUND(OutData%f2,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%f2 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%f2))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%f2) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%f2,1), UBOUND(OutData%f2,1) + OutData%f2(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%f3,1) i1_u = UBOUND(OutData%f3,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%f3 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%f3))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%f3) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%f3,1), UBOUND(OutData%f3,1) + OutData%f3(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%g1,1) i1_u = UBOUND(OutData%g1,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%g1 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%g1))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%g1) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%g1,1), UBOUND(OutData%g1,1) + OutData%g1(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%g2,1) i1_u = UBOUND(OutData%g2,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%g2 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%g2))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%g2) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%g2,1), UBOUND(OutData%g2,1) + OutData%g2(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%g3,1) i1_u = UBOUND(OutData%g3,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%g3 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%g3))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%g3) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%g3,1), UBOUND(OutData%g3,1) + OutData%g3(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! i1 not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -7374,15 +7275,12 @@ SUBROUTINE ED_UnPackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%i1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%i1)>0) OutData%i1 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%i1))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%i1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%i1,2), UBOUND(OutData%i1,2) + DO i1 = LBOUND(OutData%i1,1), UBOUND(OutData%i1,1) + OutData%i1(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! i2 not allocated Int_Xferred = Int_Xferred + 1 @@ -7400,15 +7298,12 @@ SUBROUTINE ED_UnPackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%i2.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%i2)>0) OutData%i2 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%i2))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%i2) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%i2,2), UBOUND(OutData%i2,2) + DO i1 = LBOUND(OutData%i2,1), UBOUND(OutData%i2,1) + OutData%i2(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! i3 not allocated Int_Xferred = Int_Xferred + 1 @@ -7426,15 +7321,12 @@ SUBROUTINE ED_UnPackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%i3.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%i3)>0) OutData%i3 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%i3))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%i3) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%i3,2), UBOUND(OutData%i3,2) + DO i1 = LBOUND(OutData%i3,1), UBOUND(OutData%i3,1) + OutData%i3(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! j1 not allocated Int_Xferred = Int_Xferred + 1 @@ -7452,15 +7344,12 @@ SUBROUTINE ED_UnPackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%j1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%j1)>0) OutData%j1 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%j1))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%j1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%j1,2), UBOUND(OutData%j1,2) + DO i1 = LBOUND(OutData%j1,1), UBOUND(OutData%j1,1) + OutData%j1(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! j2 not allocated Int_Xferred = Int_Xferred + 1 @@ -7478,15 +7367,12 @@ SUBROUTINE ED_UnPackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%j2.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%j2)>0) OutData%j2 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%j2))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%j2) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%j2,2), UBOUND(OutData%j2,2) + DO i1 = LBOUND(OutData%j2,1), UBOUND(OutData%j2,1) + OutData%j2(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! j3 not allocated Int_Xferred = Int_Xferred + 1 @@ -7504,15 +7390,12 @@ SUBROUTINE ED_UnPackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%j3.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%j3)>0) OutData%j3 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%j3))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%j3) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%j3,2), UBOUND(OutData%j3,2) + DO i1 = LBOUND(OutData%j3,1), UBOUND(OutData%j3,1) + OutData%j3(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! m1 not allocated Int_Xferred = Int_Xferred + 1 @@ -7533,15 +7416,14 @@ SUBROUTINE ED_UnPackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%m1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%m1)>0) OutData%m1 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%m1))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%m1) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%m1,3), UBOUND(OutData%m1,3) + DO i2 = LBOUND(OutData%m1,2), UBOUND(OutData%m1,2) + DO i1 = LBOUND(OutData%m1,1), UBOUND(OutData%m1,1) + OutData%m1(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! m2 not allocated Int_Xferred = Int_Xferred + 1 @@ -7562,15 +7444,14 @@ SUBROUTINE ED_UnPackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%m2.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%m2)>0) OutData%m2 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%m2))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%m2) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%m2,3), UBOUND(OutData%m2,3) + DO i2 = LBOUND(OutData%m2,2), UBOUND(OutData%m2,2) + DO i1 = LBOUND(OutData%m2,1), UBOUND(OutData%m2,1) + OutData%m2(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! m3 not allocated Int_Xferred = Int_Xferred + 1 @@ -7591,15 +7472,14 @@ SUBROUTINE ED_UnPackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%m3.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%m3)>0) OutData%m3 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%m3))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%m3) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%m3,3), UBOUND(OutData%m3,3) + DO i2 = LBOUND(OutData%m3,2), UBOUND(OutData%m3,2) + DO i1 = LBOUND(OutData%m3,1), UBOUND(OutData%m3,1) + OutData%m3(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! n1 not allocated Int_Xferred = Int_Xferred + 1 @@ -7620,15 +7500,14 @@ SUBROUTINE ED_UnPackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%n1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%n1)>0) OutData%n1 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%n1))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%n1) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%n1,3), UBOUND(OutData%n1,3) + DO i2 = LBOUND(OutData%n1,2), UBOUND(OutData%n1,2) + DO i1 = LBOUND(OutData%n1,1), UBOUND(OutData%n1,1) + OutData%n1(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! n2 not allocated Int_Xferred = Int_Xferred + 1 @@ -7649,15 +7528,14 @@ SUBROUTINE ED_UnPackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%n2.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%n2)>0) OutData%n2 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%n2))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%n2) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%n2,3), UBOUND(OutData%n2,3) + DO i2 = LBOUND(OutData%n2,2), UBOUND(OutData%n2,2) + DO i1 = LBOUND(OutData%n2,1), UBOUND(OutData%n2,1) + OutData%n2(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! n3 not allocated Int_Xferred = Int_Xferred + 1 @@ -7678,93 +7556,57 @@ SUBROUTINE ED_UnPackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%n3.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%n3)>0) OutData%n3 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%n3))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%n3) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%n3,3), UBOUND(OutData%n3,3) + DO i2 = LBOUND(OutData%n3,2), UBOUND(OutData%n3,2) + DO i1 = LBOUND(OutData%n3,1), UBOUND(OutData%n3,1) + OutData%n3(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF i1_l = LBOUND(OutData%p1,1) i1_u = UBOUND(OutData%p1,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%p1 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%p1))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%p1) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%p1,1), UBOUND(OutData%p1,1) + OutData%p1(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%p2,1) i1_u = UBOUND(OutData%p2,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%p2 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%p2))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%p2) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%p2,1), UBOUND(OutData%p2,1) + OutData%p2(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%p3,1) i1_u = UBOUND(OutData%p3,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%p3 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%p3))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%p3) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%p3,1), UBOUND(OutData%p3,1) + OutData%p3(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%rf1,1) i1_u = UBOUND(OutData%rf1,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rf1 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rf1))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rf1) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rf1,1), UBOUND(OutData%rf1,1) + OutData%rf1(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%rf2,1) i1_u = UBOUND(OutData%rf2,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rf2 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rf2))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rf2) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rf2,1), UBOUND(OutData%rf2,1) + OutData%rf2(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%rf3,1) i1_u = UBOUND(OutData%rf3,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rf3 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rf3))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rf3) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rf3,1), UBOUND(OutData%rf3,1) + OutData%rf3(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%rfa,1) i1_u = UBOUND(OutData%rfa,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rfa = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rfa))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rfa) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rfa,1), UBOUND(OutData%rfa,1) + OutData%rfa(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! t1 not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -7781,15 +7623,12 @@ SUBROUTINE ED_UnPackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%t1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%t1)>0) OutData%t1 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%t1))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%t1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%t1,2), UBOUND(OutData%t1,2) + DO i1 = LBOUND(OutData%t1,1), UBOUND(OutData%t1,1) + OutData%t1(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! t2 not allocated Int_Xferred = Int_Xferred + 1 @@ -7807,15 +7646,12 @@ SUBROUTINE ED_UnPackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%t2.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%t2)>0) OutData%t2 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%t2))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%t2) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%t2,2), UBOUND(OutData%t2,2) + DO i1 = LBOUND(OutData%t2,1), UBOUND(OutData%t2,1) + OutData%t2(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! t3 not allocated Int_Xferred = Int_Xferred + 1 @@ -7833,15 +7669,12 @@ SUBROUTINE ED_UnPackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%t3.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%t3)>0) OutData%t3 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%t3))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%t3) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%t3,2), UBOUND(OutData%t3,2) + DO i1 = LBOUND(OutData%t3,1), UBOUND(OutData%t3,1) + OutData%t3(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! te1 not allocated Int_Xferred = Int_Xferred + 1 @@ -7862,15 +7695,14 @@ SUBROUTINE ED_UnPackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%te1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%te1)>0) OutData%te1 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%te1))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%te1) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%te1,3), UBOUND(OutData%te1,3) + DO i2 = LBOUND(OutData%te1,2), UBOUND(OutData%te1,2) + DO i1 = LBOUND(OutData%te1,1), UBOUND(OutData%te1,1) + OutData%te1(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! te2 not allocated Int_Xferred = Int_Xferred + 1 @@ -7891,15 +7723,14 @@ SUBROUTINE ED_UnPackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%te2.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%te2)>0) OutData%te2 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%te2))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%te2) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%te2,3), UBOUND(OutData%te2,3) + DO i2 = LBOUND(OutData%te2,2), UBOUND(OutData%te2,2) + DO i1 = LBOUND(OutData%te2,1), UBOUND(OutData%te2,1) + OutData%te2(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! te3 not allocated Int_Xferred = Int_Xferred + 1 @@ -7920,93 +7751,57 @@ SUBROUTINE ED_UnPackCoordSys( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%te3.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%te3)>0) OutData%te3 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%te3))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%te3) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%te3,3), UBOUND(OutData%te3,3) + DO i2 = LBOUND(OutData%te3,2), UBOUND(OutData%te3,2) + DO i1 = LBOUND(OutData%te3,1), UBOUND(OutData%te3,1) + OutData%te3(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF i1_l = LBOUND(OutData%tf1,1) i1_u = UBOUND(OutData%tf1,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%tf1 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%tf1))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%tf1) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%tf1,1), UBOUND(OutData%tf1,1) + OutData%tf1(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%tf2,1) i1_u = UBOUND(OutData%tf2,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%tf2 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%tf2))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%tf2) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%tf2,1), UBOUND(OutData%tf2,1) + OutData%tf2(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%tf3,1) i1_u = UBOUND(OutData%tf3,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%tf3 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%tf3))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%tf3) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%tf3,1), UBOUND(OutData%tf3,1) + OutData%tf3(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%tfa,1) i1_u = UBOUND(OutData%tfa,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%tfa = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%tfa))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%tfa) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%tfa,1), UBOUND(OutData%tfa,1) + OutData%tfa(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%z1,1) i1_u = UBOUND(OutData%z1,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%z1 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%z1))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%z1) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%z1,1), UBOUND(OutData%z1,1) + OutData%z1(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%z2,1) i1_u = UBOUND(OutData%z2,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%z2 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%z2))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%z2) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%z2,1), UBOUND(OutData%z2,1) + OutData%z2(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%z3,1) i1_u = UBOUND(OutData%z3,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%z3 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%z3))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%z3) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%z3,1), UBOUND(OutData%z3,1) + OutData%z3(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO END SUBROUTINE ED_UnPackCoordSys SUBROUTINE ED_CopyActiveDOFs( SrcActiveDOFsData, DstActiveDOFsData, CtrlCode, ErrStat, ErrMsg ) @@ -8420,18 +8215,18 @@ SUBROUTINE ED_PackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NActvDOF - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NPCE - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NPDE - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NPIE - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NPTE - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NPTTE - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NActvDOF + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NPCE + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NPDE + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NPIE + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NPTE + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NPTTE + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%NPSBE) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -8442,8 +8237,10 @@ SUBROUTINE ED_PackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NPSBE,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%NPSBE)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%NPSBE))-1 ) = PACK(InData%NPSBE,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%NPSBE) + DO i1 = LBOUND(InData%NPSBE,1), UBOUND(InData%NPSBE,1) + IntKiBuf(Int_Xferred) = InData%NPSBE(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%NPSE) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8455,13 +8252,15 @@ SUBROUTINE ED_PackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NPSE,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%NPSE)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%NPSE))-1 ) = PACK(InData%NPSE,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%NPSE) + DO i1 = LBOUND(InData%NPSE,1), UBOUND(InData%NPSE,1) + IntKiBuf(Int_Xferred) = InData%NPSE(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NPUE - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NPYE - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NPUE + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NPYE + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%PCE) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -8472,8 +8271,10 @@ SUBROUTINE ED_PackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PCE,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PCE)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%PCE))-1 ) = PACK(InData%PCE,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%PCE) + DO i1 = LBOUND(InData%PCE,1), UBOUND(InData%PCE,1) + IntKiBuf(Int_Xferred) = InData%PCE(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%PDE) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8485,8 +8286,10 @@ SUBROUTINE ED_PackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PDE,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PDE)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%PDE))-1 ) = PACK(InData%PDE,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%PDE) + DO i1 = LBOUND(InData%PDE,1), UBOUND(InData%PDE,1) + IntKiBuf(Int_Xferred) = InData%PDE(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%PIE) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8498,8 +8301,10 @@ SUBROUTINE ED_PackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PIE,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PIE)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%PIE))-1 ) = PACK(InData%PIE,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%PIE) + DO i1 = LBOUND(InData%PIE,1), UBOUND(InData%PIE,1) + IntKiBuf(Int_Xferred) = InData%PIE(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%PTE) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8511,8 +8316,10 @@ SUBROUTINE ED_PackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PTE,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PTE)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%PTE))-1 ) = PACK(InData%PTE,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%PTE) + DO i1 = LBOUND(InData%PTE,1), UBOUND(InData%PTE,1) + IntKiBuf(Int_Xferred) = InData%PTE(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%PTTE) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8524,8 +8331,10 @@ SUBROUTINE ED_PackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PTTE,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PTTE)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%PTTE))-1 ) = PACK(InData%PTTE,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%PTTE) + DO i1 = LBOUND(InData%PTTE,1), UBOUND(InData%PTTE,1) + IntKiBuf(Int_Xferred) = InData%PTTE(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%PS) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8537,8 +8346,10 @@ SUBROUTINE ED_PackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PS,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PS)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%PS))-1 ) = PACK(InData%PS,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%PS) + DO i1 = LBOUND(InData%PS,1), UBOUND(InData%PS,1) + IntKiBuf(Int_Xferred) = InData%PS(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%PSBE) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8553,8 +8364,12 @@ SUBROUTINE ED_PackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PSBE,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PSBE)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%PSBE))-1 ) = PACK(InData%PSBE,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%PSBE) + DO i2 = LBOUND(InData%PSBE,2), UBOUND(InData%PSBE,2) + DO i1 = LBOUND(InData%PSBE,1), UBOUND(InData%PSBE,1) + IntKiBuf(Int_Xferred) = InData%PSBE(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PSE) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8569,8 +8384,12 @@ SUBROUTINE ED_PackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PSE,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PSE)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%PSE))-1 ) = PACK(InData%PSE,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%PSE) + DO i2 = LBOUND(InData%PSE,2), UBOUND(InData%PSE,2) + DO i1 = LBOUND(InData%PSE,1), UBOUND(InData%PSE,1) + IntKiBuf(Int_Xferred) = InData%PSE(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PUE) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8582,8 +8401,10 @@ SUBROUTINE ED_PackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PUE,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PUE)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%PUE))-1 ) = PACK(InData%PUE,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%PUE) + DO i1 = LBOUND(InData%PUE,1), UBOUND(InData%PUE,1) + IntKiBuf(Int_Xferred) = InData%PUE(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%PYE) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8595,8 +8416,10 @@ SUBROUTINE ED_PackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PYE,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PYE)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%PYE))-1 ) = PACK(InData%PYE,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%PYE) + DO i1 = LBOUND(InData%PYE,1), UBOUND(InData%PYE,1) + IntKiBuf(Int_Xferred) = InData%PYE(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%SrtPS) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8608,8 +8431,10 @@ SUBROUTINE ED_PackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SrtPS,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%SrtPS)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%SrtPS))-1 ) = PACK(InData%SrtPS,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%SrtPS) + DO i1 = LBOUND(InData%SrtPS,1), UBOUND(InData%SrtPS,1) + IntKiBuf(Int_Xferred) = InData%SrtPS(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%SrtPSNAUG) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8621,8 +8446,10 @@ SUBROUTINE ED_PackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SrtPSNAUG,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%SrtPSNAUG)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%SrtPSNAUG))-1 ) = PACK(InData%SrtPSNAUG,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%SrtPSNAUG) + DO i1 = LBOUND(InData%SrtPSNAUG,1), UBOUND(InData%SrtPSNAUG,1) + IntKiBuf(Int_Xferred) = InData%SrtPSNAUG(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%Diag) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8634,8 +8461,10 @@ SUBROUTINE ED_PackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Diag,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Diag)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%Diag))-1 ) = PACK(InData%Diag,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%Diag) + DO i1 = LBOUND(InData%Diag,1), UBOUND(InData%Diag,1) + IntKiBuf(Int_Xferred) = InData%Diag(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF END SUBROUTINE ED_PackActiveDOFs @@ -8652,12 +8481,6 @@ SUBROUTINE ED_UnPackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -8673,18 +8496,18 @@ SUBROUTINE ED_UnPackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%NActvDOF = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NPCE = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NPDE = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NPIE = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NPTE = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NPTTE = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NActvDOF = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NPCE = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NPDE = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NPIE = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NPTE = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NPTTE = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NPSBE not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -8698,15 +8521,10 @@ SUBROUTINE ED_UnPackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NPSBE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%NPSBE)>0) OutData%NPSBE = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%NPSBE))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%NPSBE) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%NPSBE,1), UBOUND(OutData%NPSBE,1) + OutData%NPSBE(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NPSE not allocated Int_Xferred = Int_Xferred + 1 @@ -8721,20 +8539,15 @@ SUBROUTINE ED_UnPackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NPSE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%NPSE)>0) OutData%NPSE = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%NPSE))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%NPSE) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%NPSE,1), UBOUND(OutData%NPSE,1) + OutData%NPSE(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF - OutData%NPUE = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NPYE = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NPUE = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NPYE = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PCE not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -8748,15 +8561,10 @@ SUBROUTINE ED_UnPackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PCE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%PCE)>0) OutData%PCE = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%PCE))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%PCE) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%PCE,1), UBOUND(OutData%PCE,1) + OutData%PCE(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PDE not allocated Int_Xferred = Int_Xferred + 1 @@ -8771,15 +8579,10 @@ SUBROUTINE ED_UnPackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PDE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%PDE)>0) OutData%PDE = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%PDE))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%PDE) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%PDE,1), UBOUND(OutData%PDE,1) + OutData%PDE(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PIE not allocated Int_Xferred = Int_Xferred + 1 @@ -8794,15 +8597,10 @@ SUBROUTINE ED_UnPackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PIE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%PIE)>0) OutData%PIE = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%PIE))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%PIE) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%PIE,1), UBOUND(OutData%PIE,1) + OutData%PIE(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PTE not allocated Int_Xferred = Int_Xferred + 1 @@ -8817,15 +8615,10 @@ SUBROUTINE ED_UnPackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PTE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%PTE)>0) OutData%PTE = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%PTE))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%PTE) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%PTE,1), UBOUND(OutData%PTE,1) + OutData%PTE(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PTTE not allocated Int_Xferred = Int_Xferred + 1 @@ -8840,15 +8633,10 @@ SUBROUTINE ED_UnPackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PTTE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%PTTE)>0) OutData%PTTE = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%PTTE))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%PTTE) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%PTTE,1), UBOUND(OutData%PTTE,1) + OutData%PTTE(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PS not allocated Int_Xferred = Int_Xferred + 1 @@ -8863,15 +8651,10 @@ SUBROUTINE ED_UnPackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PS.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%PS)>0) OutData%PS = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%PS))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%PS) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%PS,1), UBOUND(OutData%PS,1) + OutData%PS(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PSBE not allocated Int_Xferred = Int_Xferred + 1 @@ -8889,15 +8672,12 @@ SUBROUTINE ED_UnPackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PSBE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PSBE)>0) OutData%PSBE = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%PSBE))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%PSBE) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PSBE,2), UBOUND(OutData%PSBE,2) + DO i1 = LBOUND(OutData%PSBE,1), UBOUND(OutData%PSBE,1) + OutData%PSBE(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PSE not allocated Int_Xferred = Int_Xferred + 1 @@ -8915,15 +8695,12 @@ SUBROUTINE ED_UnPackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PSE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PSE)>0) OutData%PSE = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%PSE))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%PSE) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PSE,2), UBOUND(OutData%PSE,2) + DO i1 = LBOUND(OutData%PSE,1), UBOUND(OutData%PSE,1) + OutData%PSE(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PUE not allocated Int_Xferred = Int_Xferred + 1 @@ -8938,15 +8715,10 @@ SUBROUTINE ED_UnPackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PUE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%PUE)>0) OutData%PUE = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%PUE))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%PUE) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%PUE,1), UBOUND(OutData%PUE,1) + OutData%PUE(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PYE not allocated Int_Xferred = Int_Xferred + 1 @@ -8961,15 +8733,10 @@ SUBROUTINE ED_UnPackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PYE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%PYE)>0) OutData%PYE = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%PYE))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%PYE) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%PYE,1), UBOUND(OutData%PYE,1) + OutData%PYE(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SrtPS not allocated Int_Xferred = Int_Xferred + 1 @@ -8984,15 +8751,10 @@ SUBROUTINE ED_UnPackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SrtPS.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%SrtPS)>0) OutData%SrtPS = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%SrtPS))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%SrtPS) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%SrtPS,1), UBOUND(OutData%SrtPS,1) + OutData%SrtPS(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SrtPSNAUG not allocated Int_Xferred = Int_Xferred + 1 @@ -9007,15 +8769,10 @@ SUBROUTINE ED_UnPackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SrtPSNAUG.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%SrtPSNAUG)>0) OutData%SrtPSNAUG = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%SrtPSNAUG))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%SrtPSNAUG) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%SrtPSNAUG,1), UBOUND(OutData%SrtPSNAUG,1) + OutData%SrtPSNAUG(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Diag not allocated Int_Xferred = Int_Xferred + 1 @@ -9030,15 +8787,10 @@ SUBROUTINE ED_UnPackActiveDOFs( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Diag.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Diag)>0) OutData%Diag = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%Diag))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%Diag) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Diag,1), UBOUND(OutData%Diag,1) + OutData%Diag(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF END SUBROUTINE ED_UnPackActiveDOFs @@ -10868,8 +10620,10 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rO))-1 ) = PACK(InData%rO,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rO) + DO i1 = LBOUND(InData%rO,1), UBOUND(InData%rO,1) + DbKiBuf(Db_Xferred) = InData%rO(i1) + Db_Xferred = Db_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%rQS) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -10886,8 +10640,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rQS,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%rQS)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rQS))-1 ) = PACK(InData%rQS,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rQS) + DO i3 = LBOUND(InData%rQS,3), UBOUND(InData%rQS,3) + DO i2 = LBOUND(InData%rQS,2), UBOUND(InData%rQS,2) + DO i1 = LBOUND(InData%rQS,1), UBOUND(InData%rQS,1) + DbKiBuf(Db_Xferred) = InData%rQS(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%rS) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10905,8 +10665,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rS,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%rS)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rS))-1 ) = PACK(InData%rS,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rS) + DO i3 = LBOUND(InData%rS,3), UBOUND(InData%rS,3) + DO i2 = LBOUND(InData%rS,2), UBOUND(InData%rS,2) + DO i1 = LBOUND(InData%rS,1), UBOUND(InData%rS,1) + DbKiBuf(Db_Xferred) = InData%rS(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%rS0S) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10924,8 +10690,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rS0S,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%rS0S)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rS0S))-1 ) = PACK(InData%rS0S,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rS0S) + DO i3 = LBOUND(InData%rS0S,3), UBOUND(InData%rS0S,3) + DO i2 = LBOUND(InData%rS0S,2), UBOUND(InData%rS0S,2) + DO i1 = LBOUND(InData%rS0S,1), UBOUND(InData%rS0S,1) + DbKiBuf(Db_Xferred) = InData%rS0S(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%rT) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -10940,11 +10712,17 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rT,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%rT)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rT))-1 ) = PACK(InData%rT,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rT) + DO i2 = LBOUND(InData%rT,2), UBOUND(InData%rT,2) + DO i1 = LBOUND(InData%rT,1), UBOUND(InData%rT,1) + DbKiBuf(Db_Xferred) = InData%rT(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rT0O))-1 ) = PACK(InData%rT0O,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rT0O) + DO i1 = LBOUND(InData%rT0O,1), UBOUND(InData%rT0O,1) + DbKiBuf(Db_Xferred) = InData%rT0O(i1) + Db_Xferred = Db_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%rT0T) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -10958,13 +10736,21 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rT0T,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%rT0T)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rT0T))-1 ) = PACK(InData%rT0T,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rT0T) + DO i2 = LBOUND(InData%rT0T,2), UBOUND(InData%rT0T,2) + DO i1 = LBOUND(InData%rT0T,1), UBOUND(InData%rT0T,1) + DbKiBuf(Db_Xferred) = InData%rT0T(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rZ))-1 ) = PACK(InData%rZ,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rZ) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rZO))-1 ) = PACK(InData%rZO,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rZO) + DO i1 = LBOUND(InData%rZ,1), UBOUND(InData%rZ,1) + DbKiBuf(Db_Xferred) = InData%rZ(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%rZO,1), UBOUND(InData%rZO,1) + DbKiBuf(Db_Xferred) = InData%rZO(i1) + Db_Xferred = Db_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%rZT) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -10978,27 +10764,49 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rZT,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%rZT)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rZT))-1 ) = PACK(InData%rZT,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rZT) - END IF - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rPQ))-1 ) = PACK(InData%rPQ,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rPQ) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rP))-1 ) = PACK(InData%rP,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rP) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rV))-1 ) = PACK(InData%rV,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rV) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rZY))-1 ) = PACK(InData%rZY,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rZY) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rOU))-1 ) = PACK(InData%rOU,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rOU) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rOV))-1 ) = PACK(InData%rOV,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rOV) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rVD))-1 ) = PACK(InData%rVD,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rVD) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rOW))-1 ) = PACK(InData%rOW,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rOW) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rPC))-1 ) = PACK(InData%rPC,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rPC) + DO i2 = LBOUND(InData%rZT,2), UBOUND(InData%rZT,2) + DO i1 = LBOUND(InData%rZT,1), UBOUND(InData%rZT,1) + DbKiBuf(Db_Xferred) = InData%rZT(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + DO i1 = LBOUND(InData%rPQ,1), UBOUND(InData%rPQ,1) + DbKiBuf(Db_Xferred) = InData%rPQ(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%rP,1), UBOUND(InData%rP,1) + DbKiBuf(Db_Xferred) = InData%rP(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%rV,1), UBOUND(InData%rV,1) + DbKiBuf(Db_Xferred) = InData%rV(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%rZY,1), UBOUND(InData%rZY,1) + DbKiBuf(Db_Xferred) = InData%rZY(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%rOU,1), UBOUND(InData%rOU,1) + DbKiBuf(Db_Xferred) = InData%rOU(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%rOV,1), UBOUND(InData%rOV,1) + DbKiBuf(Db_Xferred) = InData%rOV(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%rVD,1), UBOUND(InData%rVD,1) + DbKiBuf(Db_Xferred) = InData%rVD(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%rOW,1), UBOUND(InData%rOW,1) + DbKiBuf(Db_Xferred) = InData%rOW(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%rPC,1), UBOUND(InData%rPC,1) + DbKiBuf(Db_Xferred) = InData%rPC(i1) + Db_Xferred = Db_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%rPS0) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -11012,25 +10820,45 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rPS0,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%rPS0)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rPS0))-1 ) = PACK(InData%rPS0,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rPS0) - END IF - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rQ))-1 ) = PACK(InData%rQ,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rQ) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rQC))-1 ) = PACK(InData%rQC,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rQC) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rVIMU))-1 ) = PACK(InData%rVIMU,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rVIMU) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rVP))-1 ) = PACK(InData%rVP,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rVP) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rWI))-1 ) = PACK(InData%rWI,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rWI) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rWJ))-1 ) = PACK(InData%rWJ,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rWJ) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rWK))-1 ) = PACK(InData%rWK,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rWK) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%rZT0))-1 ) = PACK(InData%rZT0,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%rZT0) + DO i2 = LBOUND(InData%rPS0,2), UBOUND(InData%rPS0,2) + DO i1 = LBOUND(InData%rPS0,1), UBOUND(InData%rPS0,1) + DbKiBuf(Db_Xferred) = InData%rPS0(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + DO i1 = LBOUND(InData%rQ,1), UBOUND(InData%rQ,1) + DbKiBuf(Db_Xferred) = InData%rQ(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%rQC,1), UBOUND(InData%rQC,1) + DbKiBuf(Db_Xferred) = InData%rQC(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%rVIMU,1), UBOUND(InData%rVIMU,1) + DbKiBuf(Db_Xferred) = InData%rVIMU(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%rVP,1), UBOUND(InData%rVP,1) + DbKiBuf(Db_Xferred) = InData%rVP(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%rWI,1), UBOUND(InData%rWI,1) + DbKiBuf(Db_Xferred) = InData%rWI(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%rWJ,1), UBOUND(InData%rWJ,1) + DbKiBuf(Db_Xferred) = InData%rWJ(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%rWK,1), UBOUND(InData%rWK,1) + DbKiBuf(Db_Xferred) = InData%rWK(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%rZT0,1), UBOUND(InData%rZT0,1) + DbKiBuf(Db_Xferred) = InData%rZT0(i1) + Db_Xferred = Db_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%AngPosEF) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -11044,8 +10872,12 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngPosEF,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AngPosEF)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AngPosEF))-1 ) = PACK(InData%AngPosEF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AngPosEF) + DO i2 = LBOUND(InData%AngPosEF,2), UBOUND(InData%AngPosEF,2) + DO i1 = LBOUND(InData%AngPosEF,1), UBOUND(InData%AngPosEF,1) + ReKiBuf(Re_Xferred) = InData%AngPosEF(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%AngPosXF) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11060,8 +10892,12 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngPosXF,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AngPosXF)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AngPosXF))-1 ) = PACK(InData%AngPosXF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AngPosXF) + DO i2 = LBOUND(InData%AngPosXF,2), UBOUND(InData%AngPosXF,2) + DO i1 = LBOUND(InData%AngPosXF,1), UBOUND(InData%AngPosXF,1) + ReKiBuf(Re_Xferred) = InData%AngPosXF(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%AngPosHM) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11079,13 +10915,23 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngPosHM,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AngPosHM)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AngPosHM))-1 ) = PACK(InData%AngPosHM,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AngPosHM) + DO i3 = LBOUND(InData%AngPosHM,3), UBOUND(InData%AngPosHM,3) + DO i2 = LBOUND(InData%AngPosHM,2), UBOUND(InData%AngPosHM,2) + DO i1 = LBOUND(InData%AngPosHM,1), UBOUND(InData%AngPosHM,1) + ReKiBuf(Re_Xferred) = InData%AngPosHM(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AngPosXB))-1 ) = PACK(InData%AngPosXB,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AngPosXB) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AngPosEX))-1 ) = PACK(InData%AngPosEX,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AngPosEX) + DO i1 = LBOUND(InData%AngPosXB,1), UBOUND(InData%AngPosXB,1) + ReKiBuf(Re_Xferred) = InData%AngPosXB(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%AngPosEX,1), UBOUND(InData%AngPosEX,1) + ReKiBuf(Re_Xferred) = InData%AngPosEX(i1) + Re_Xferred = Re_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%PAngVelEA) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -11102,8 +10948,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEA,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PAngVelEA)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PAngVelEA))-1 ) = PACK(InData%PAngVelEA,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PAngVelEA) + DO i3 = LBOUND(InData%PAngVelEA,3), UBOUND(InData%PAngVelEA,3) + DO i2 = LBOUND(InData%PAngVelEA,2), UBOUND(InData%PAngVelEA,2) + DO i1 = LBOUND(InData%PAngVelEA,1), UBOUND(InData%PAngVelEA,1) + ReKiBuf(Re_Xferred) = InData%PAngVelEA(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PAngVelEF) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11124,8 +10976,16 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEF,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PAngVelEF)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PAngVelEF))-1 ) = PACK(InData%PAngVelEF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PAngVelEF) + DO i4 = LBOUND(InData%PAngVelEF,4), UBOUND(InData%PAngVelEF,4) + DO i3 = LBOUND(InData%PAngVelEF,3), UBOUND(InData%PAngVelEF,3) + DO i2 = LBOUND(InData%PAngVelEF,2), UBOUND(InData%PAngVelEF,2) + DO i1 = LBOUND(InData%PAngVelEF,1), UBOUND(InData%PAngVelEF,1) + ReKiBuf(Re_Xferred) = InData%PAngVelEF(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PAngVelEG) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11143,8 +11003,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEG,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PAngVelEG)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PAngVelEG))-1 ) = PACK(InData%PAngVelEG,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PAngVelEG) + DO i3 = LBOUND(InData%PAngVelEG,3), UBOUND(InData%PAngVelEG,3) + DO i2 = LBOUND(InData%PAngVelEG,2), UBOUND(InData%PAngVelEG,2) + DO i1 = LBOUND(InData%PAngVelEG,1), UBOUND(InData%PAngVelEG,1) + ReKiBuf(Re_Xferred) = InData%PAngVelEG(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PAngVelEH) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11162,8 +11028,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEH,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PAngVelEH)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PAngVelEH))-1 ) = PACK(InData%PAngVelEH,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PAngVelEH) + DO i3 = LBOUND(InData%PAngVelEH,3), UBOUND(InData%PAngVelEH,3) + DO i2 = LBOUND(InData%PAngVelEH,2), UBOUND(InData%PAngVelEH,2) + DO i1 = LBOUND(InData%PAngVelEH,1), UBOUND(InData%PAngVelEH,1) + ReKiBuf(Re_Xferred) = InData%PAngVelEH(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PAngVelEL) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11181,8 +11053,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEL,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PAngVelEL)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PAngVelEL))-1 ) = PACK(InData%PAngVelEL,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PAngVelEL) + DO i3 = LBOUND(InData%PAngVelEL,3), UBOUND(InData%PAngVelEL,3) + DO i2 = LBOUND(InData%PAngVelEL,2), UBOUND(InData%PAngVelEL,2) + DO i1 = LBOUND(InData%PAngVelEL,1), UBOUND(InData%PAngVelEL,1) + ReKiBuf(Re_Xferred) = InData%PAngVelEL(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PAngVelEM) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11206,8 +11084,18 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEM,5) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PAngVelEM)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PAngVelEM))-1 ) = PACK(InData%PAngVelEM,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PAngVelEM) + DO i5 = LBOUND(InData%PAngVelEM,5), UBOUND(InData%PAngVelEM,5) + DO i4 = LBOUND(InData%PAngVelEM,4), UBOUND(InData%PAngVelEM,4) + DO i3 = LBOUND(InData%PAngVelEM,3), UBOUND(InData%PAngVelEM,3) + DO i2 = LBOUND(InData%PAngVelEM,2), UBOUND(InData%PAngVelEM,2) + DO i1 = LBOUND(InData%PAngVelEM,1), UBOUND(InData%PAngVelEM,1) + ReKiBuf(Re_Xferred) = InData%PAngVelEM(i1,i2,i3,i4,i5) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%AngVelEM) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11225,8 +11113,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngVelEM,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AngVelEM)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AngVelEM))-1 ) = PACK(InData%AngVelEM,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AngVelEM) + DO i3 = LBOUND(InData%AngVelEM,3), UBOUND(InData%AngVelEM,3) + DO i2 = LBOUND(InData%AngVelEM,2), UBOUND(InData%AngVelEM,2) + DO i1 = LBOUND(InData%AngVelEM,1), UBOUND(InData%AngVelEM,1) + ReKiBuf(Re_Xferred) = InData%AngVelEM(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PAngVelEN) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11244,11 +11138,19 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEN,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PAngVelEN)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PAngVelEN))-1 ) = PACK(InData%PAngVelEN,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PAngVelEN) + DO i3 = LBOUND(InData%PAngVelEN,3), UBOUND(InData%PAngVelEN,3) + DO i2 = LBOUND(InData%PAngVelEN,2), UBOUND(InData%PAngVelEN,2) + DO i1 = LBOUND(InData%PAngVelEN,1), UBOUND(InData%PAngVelEN,1) + ReKiBuf(Re_Xferred) = InData%PAngVelEN(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AngVelEA))-1 ) = PACK(InData%AngVelEA,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AngVelEA) + DO i1 = LBOUND(InData%AngVelEA,1), UBOUND(InData%AngVelEA,1) + ReKiBuf(Re_Xferred) = InData%AngVelEA(i1) + Re_Xferred = Re_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%PAngVelEB) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -11265,8 +11167,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEB,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PAngVelEB)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PAngVelEB))-1 ) = PACK(InData%PAngVelEB,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PAngVelEB) + DO i3 = LBOUND(InData%PAngVelEB,3), UBOUND(InData%PAngVelEB,3) + DO i2 = LBOUND(InData%PAngVelEB,2), UBOUND(InData%PAngVelEB,2) + DO i1 = LBOUND(InData%PAngVelEB,1), UBOUND(InData%PAngVelEB,1) + ReKiBuf(Re_Xferred) = InData%PAngVelEB(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PAngVelER) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11284,8 +11192,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelER,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PAngVelER)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PAngVelER))-1 ) = PACK(InData%PAngVelER,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PAngVelER) + DO i3 = LBOUND(InData%PAngVelER,3), UBOUND(InData%PAngVelER,3) + DO i2 = LBOUND(InData%PAngVelER,2), UBOUND(InData%PAngVelER,2) + DO i1 = LBOUND(InData%PAngVelER,1), UBOUND(InData%PAngVelER,1) + ReKiBuf(Re_Xferred) = InData%PAngVelER(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PAngVelEX) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11303,31 +11217,57 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PAngVelEX,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PAngVelEX)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PAngVelEX))-1 ) = PACK(InData%PAngVelEX,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PAngVelEX) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AngVelEG))-1 ) = PACK(InData%AngVelEG,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AngVelEG) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AngVelEH))-1 ) = PACK(InData%AngVelEH,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AngVelEH) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AngVelEL))-1 ) = PACK(InData%AngVelEL,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AngVelEL) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AngVelEN))-1 ) = PACK(InData%AngVelEN,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AngVelEN) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AngVelEB))-1 ) = PACK(InData%AngVelEB,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AngVelEB) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AngVelER))-1 ) = PACK(InData%AngVelER,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AngVelER) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AngVelEX))-1 ) = PACK(InData%AngVelEX,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AngVelEX) - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%TeetAngVel - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AngAccEBt))-1 ) = PACK(InData%AngAccEBt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AngAccEBt) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AngAccERt))-1 ) = PACK(InData%AngAccERt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AngAccERt) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AngAccEXt))-1 ) = PACK(InData%AngAccEXt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AngAccEXt) + DO i3 = LBOUND(InData%PAngVelEX,3), UBOUND(InData%PAngVelEX,3) + DO i2 = LBOUND(InData%PAngVelEX,2), UBOUND(InData%PAngVelEX,2) + DO i1 = LBOUND(InData%PAngVelEX,1), UBOUND(InData%PAngVelEX,1) + ReKiBuf(Re_Xferred) = InData%PAngVelEX(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + DO i1 = LBOUND(InData%AngVelEG,1), UBOUND(InData%AngVelEG,1) + ReKiBuf(Re_Xferred) = InData%AngVelEG(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%AngVelEH,1), UBOUND(InData%AngVelEH,1) + ReKiBuf(Re_Xferred) = InData%AngVelEH(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%AngVelEL,1), UBOUND(InData%AngVelEL,1) + ReKiBuf(Re_Xferred) = InData%AngVelEL(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%AngVelEN,1), UBOUND(InData%AngVelEN,1) + ReKiBuf(Re_Xferred) = InData%AngVelEN(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%AngVelEB,1), UBOUND(InData%AngVelEB,1) + ReKiBuf(Re_Xferred) = InData%AngVelEB(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%AngVelER,1), UBOUND(InData%AngVelER,1) + ReKiBuf(Re_Xferred) = InData%AngVelER(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%AngVelEX,1), UBOUND(InData%AngVelEX,1) + ReKiBuf(Re_Xferred) = InData%AngVelEX(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DbKiBuf(Db_Xferred) = InData%TeetAngVel + Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(InData%AngAccEBt,1), UBOUND(InData%AngAccEBt,1) + ReKiBuf(Re_Xferred) = InData%AngAccEBt(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%AngAccERt,1), UBOUND(InData%AngAccERt,1) + ReKiBuf(Re_Xferred) = InData%AngAccERt(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%AngAccEXt,1), UBOUND(InData%AngAccEXt,1) + ReKiBuf(Re_Xferred) = InData%AngAccEXt(i1) + Re_Xferred = Re_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%AngAccEFt) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -11341,8 +11281,12 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngAccEFt,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AngAccEFt)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AngAccEFt))-1 ) = PACK(InData%AngAccEFt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AngAccEFt) + DO i2 = LBOUND(InData%AngAccEFt,2), UBOUND(InData%AngAccEFt,2) + DO i1 = LBOUND(InData%AngAccEFt,1), UBOUND(InData%AngAccEFt,1) + ReKiBuf(Re_Xferred) = InData%AngAccEFt(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%AngVelEF) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11357,29 +11301,53 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AngVelEF,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AngVelEF)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AngVelEF))-1 ) = PACK(InData%AngVelEF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AngVelEF) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AngAccEAt))-1 ) = PACK(InData%AngAccEAt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AngAccEAt) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AngAccEGt))-1 ) = PACK(InData%AngAccEGt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AngAccEGt) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AngAccEHt))-1 ) = PACK(InData%AngAccEHt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AngAccEHt) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AngAccENt))-1 ) = PACK(InData%AngAccENt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AngAccENt) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LinAccECt))-1 ) = PACK(InData%LinAccECt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LinAccECt) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LinAccEDt))-1 ) = PACK(InData%LinAccEDt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LinAccEDt) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LinAccEIt))-1 ) = PACK(InData%LinAccEIt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LinAccEIt) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LinAccEJt))-1 ) = PACK(InData%LinAccEJt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LinAccEJt) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LinAccEUt))-1 ) = PACK(InData%LinAccEUt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LinAccEUt) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LinAccEYt))-1 ) = PACK(InData%LinAccEYt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LinAccEYt) + DO i2 = LBOUND(InData%AngVelEF,2), UBOUND(InData%AngVelEF,2) + DO i1 = LBOUND(InData%AngVelEF,1), UBOUND(InData%AngVelEF,1) + ReKiBuf(Re_Xferred) = InData%AngVelEF(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + DO i1 = LBOUND(InData%AngAccEAt,1), UBOUND(InData%AngAccEAt,1) + ReKiBuf(Re_Xferred) = InData%AngAccEAt(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%AngAccEGt,1), UBOUND(InData%AngAccEGt,1) + ReKiBuf(Re_Xferred) = InData%AngAccEGt(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%AngAccEHt,1), UBOUND(InData%AngAccEHt,1) + ReKiBuf(Re_Xferred) = InData%AngAccEHt(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%AngAccENt,1), UBOUND(InData%AngAccENt,1) + ReKiBuf(Re_Xferred) = InData%AngAccENt(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%LinAccECt,1), UBOUND(InData%LinAccECt,1) + ReKiBuf(Re_Xferred) = InData%LinAccECt(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%LinAccEDt,1), UBOUND(InData%LinAccEDt,1) + ReKiBuf(Re_Xferred) = InData%LinAccEDt(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%LinAccEIt,1), UBOUND(InData%LinAccEIt,1) + ReKiBuf(Re_Xferred) = InData%LinAccEIt(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%LinAccEJt,1), UBOUND(InData%LinAccEJt,1) + ReKiBuf(Re_Xferred) = InData%LinAccEJt(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%LinAccEUt,1), UBOUND(InData%LinAccEUt,1) + ReKiBuf(Re_Xferred) = InData%LinAccEUt(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%LinAccEYt,1), UBOUND(InData%LinAccEYt,1) + ReKiBuf(Re_Xferred) = InData%LinAccEYt(i1) + Re_Xferred = Re_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%LinVelES) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -11396,11 +11364,19 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinVelES,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LinVelES)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LinVelES))-1 ) = PACK(InData%LinVelES,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LinVelES) + DO i3 = LBOUND(InData%LinVelES,3), UBOUND(InData%LinVelES,3) + DO i2 = LBOUND(InData%LinVelES,2), UBOUND(InData%LinVelES,2) + DO i1 = LBOUND(InData%LinVelES,1), UBOUND(InData%LinVelES,1) + ReKiBuf(Re_Xferred) = InData%LinVelES(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LinVelEQ))-1 ) = PACK(InData%LinVelEQ,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LinVelEQ) + DO i1 = LBOUND(InData%LinVelEQ,1), UBOUND(InData%LinVelEQ,1) + ReKiBuf(Re_Xferred) = InData%LinVelEQ(i1) + Re_Xferred = Re_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%LinVelET) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -11414,8 +11390,12 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinVelET,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LinVelET)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LinVelET))-1 ) = PACK(InData%LinVelET,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LinVelET) + DO i2 = LBOUND(InData%LinVelET,2), UBOUND(InData%LinVelET,2) + DO i1 = LBOUND(InData%LinVelET,1), UBOUND(InData%LinVelET,1) + ReKiBuf(Re_Xferred) = InData%LinVelET(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%LinVelESm2) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11427,8 +11407,10 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinVelESm2,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LinVelESm2)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LinVelESm2))-1 ) = PACK(InData%LinVelESm2,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LinVelESm2) + DO i1 = LBOUND(InData%LinVelESm2,1), UBOUND(InData%LinVelESm2,1) + ReKiBuf(Re_Xferred) = InData%LinVelESm2(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%PLinVelEIMU) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11446,8 +11428,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEIMU,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PLinVelEIMU)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PLinVelEIMU))-1 ) = PACK(InData%PLinVelEIMU,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PLinVelEIMU) + DO i3 = LBOUND(InData%PLinVelEIMU,3), UBOUND(InData%PLinVelEIMU,3) + DO i2 = LBOUND(InData%PLinVelEIMU,2), UBOUND(InData%PLinVelEIMU,2) + DO i1 = LBOUND(InData%PLinVelEIMU,1), UBOUND(InData%PLinVelEIMU,1) + ReKiBuf(Re_Xferred) = InData%PLinVelEIMU(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PLinVelEO) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11465,8 +11453,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEO,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PLinVelEO)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PLinVelEO))-1 ) = PACK(InData%PLinVelEO,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PLinVelEO) + DO i3 = LBOUND(InData%PLinVelEO,3), UBOUND(InData%PLinVelEO,3) + DO i2 = LBOUND(InData%PLinVelEO,2), UBOUND(InData%PLinVelEO,2) + DO i1 = LBOUND(InData%PLinVelEO,1), UBOUND(InData%PLinVelEO,1) + ReKiBuf(Re_Xferred) = InData%PLinVelEO(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PLinVelES) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11490,8 +11484,18 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelES,5) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PLinVelES)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PLinVelES))-1 ) = PACK(InData%PLinVelES,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PLinVelES) + DO i5 = LBOUND(InData%PLinVelES,5), UBOUND(InData%PLinVelES,5) + DO i4 = LBOUND(InData%PLinVelES,4), UBOUND(InData%PLinVelES,4) + DO i3 = LBOUND(InData%PLinVelES,3), UBOUND(InData%PLinVelES,3) + DO i2 = LBOUND(InData%PLinVelES,2), UBOUND(InData%PLinVelES,2) + DO i1 = LBOUND(InData%PLinVelES,1), UBOUND(InData%PLinVelES,1) + ReKiBuf(Re_Xferred) = InData%PLinVelES(i1,i2,i3,i4,i5) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PLinVelET) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11512,8 +11516,16 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelET,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PLinVelET)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PLinVelET))-1 ) = PACK(InData%PLinVelET,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PLinVelET) + DO i4 = LBOUND(InData%PLinVelET,4), UBOUND(InData%PLinVelET,4) + DO i3 = LBOUND(InData%PLinVelET,3), UBOUND(InData%PLinVelET,3) + DO i2 = LBOUND(InData%PLinVelET,2), UBOUND(InData%PLinVelET,2) + DO i1 = LBOUND(InData%PLinVelET,1), UBOUND(InData%PLinVelET,1) + ReKiBuf(Re_Xferred) = InData%PLinVelET(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PLinVelEZ) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11531,8 +11543,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEZ,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PLinVelEZ)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PLinVelEZ))-1 ) = PACK(InData%PLinVelEZ,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PLinVelEZ) + DO i3 = LBOUND(InData%PLinVelEZ,3), UBOUND(InData%PLinVelEZ,3) + DO i2 = LBOUND(InData%PLinVelEZ,2), UBOUND(InData%PLinVelEZ,2) + DO i1 = LBOUND(InData%PLinVelEZ,1), UBOUND(InData%PLinVelEZ,1) + ReKiBuf(Re_Xferred) = InData%PLinVelEZ(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PLinVelEC) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11550,8 +11568,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEC,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PLinVelEC)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PLinVelEC))-1 ) = PACK(InData%PLinVelEC,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PLinVelEC) + DO i3 = LBOUND(InData%PLinVelEC,3), UBOUND(InData%PLinVelEC,3) + DO i2 = LBOUND(InData%PLinVelEC,2), UBOUND(InData%PLinVelEC,2) + DO i1 = LBOUND(InData%PLinVelEC,1), UBOUND(InData%PLinVelEC,1) + ReKiBuf(Re_Xferred) = InData%PLinVelEC(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PLinVelED) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11569,8 +11593,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelED,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PLinVelED)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PLinVelED))-1 ) = PACK(InData%PLinVelED,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PLinVelED) + DO i3 = LBOUND(InData%PLinVelED,3), UBOUND(InData%PLinVelED,3) + DO i2 = LBOUND(InData%PLinVelED,2), UBOUND(InData%PLinVelED,2) + DO i1 = LBOUND(InData%PLinVelED,1), UBOUND(InData%PLinVelED,1) + ReKiBuf(Re_Xferred) = InData%PLinVelED(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PLinVelEI) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11588,8 +11618,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEI,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PLinVelEI)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PLinVelEI))-1 ) = PACK(InData%PLinVelEI,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PLinVelEI) + DO i3 = LBOUND(InData%PLinVelEI,3), UBOUND(InData%PLinVelEI,3) + DO i2 = LBOUND(InData%PLinVelEI,2), UBOUND(InData%PLinVelEI,2) + DO i1 = LBOUND(InData%PLinVelEI,1), UBOUND(InData%PLinVelEI,1) + ReKiBuf(Re_Xferred) = InData%PLinVelEI(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PLinVelEJ) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11607,8 +11643,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEJ,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PLinVelEJ)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PLinVelEJ))-1 ) = PACK(InData%PLinVelEJ,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PLinVelEJ) + DO i3 = LBOUND(InData%PLinVelEJ,3), UBOUND(InData%PLinVelEJ,3) + DO i2 = LBOUND(InData%PLinVelEJ,2), UBOUND(InData%PLinVelEJ,2) + DO i1 = LBOUND(InData%PLinVelEJ,1), UBOUND(InData%PLinVelEJ,1) + ReKiBuf(Re_Xferred) = InData%PLinVelEJ(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PLinVelEK) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11626,8 +11668,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEK,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PLinVelEK)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PLinVelEK))-1 ) = PACK(InData%PLinVelEK,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PLinVelEK) + DO i3 = LBOUND(InData%PLinVelEK,3), UBOUND(InData%PLinVelEK,3) + DO i2 = LBOUND(InData%PLinVelEK,2), UBOUND(InData%PLinVelEK,2) + DO i1 = LBOUND(InData%PLinVelEK,1), UBOUND(InData%PLinVelEK,1) + ReKiBuf(Re_Xferred) = InData%PLinVelEK(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PLinVelEP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11645,8 +11693,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEP,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PLinVelEP)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PLinVelEP))-1 ) = PACK(InData%PLinVelEP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PLinVelEP) + DO i3 = LBOUND(InData%PLinVelEP,3), UBOUND(InData%PLinVelEP,3) + DO i2 = LBOUND(InData%PLinVelEP,2), UBOUND(InData%PLinVelEP,2) + DO i1 = LBOUND(InData%PLinVelEP,1), UBOUND(InData%PLinVelEP,1) + ReKiBuf(Re_Xferred) = InData%PLinVelEP(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PLinVelEQ) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11664,8 +11718,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEQ,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PLinVelEQ)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PLinVelEQ))-1 ) = PACK(InData%PLinVelEQ,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PLinVelEQ) + DO i3 = LBOUND(InData%PLinVelEQ,3), UBOUND(InData%PLinVelEQ,3) + DO i2 = LBOUND(InData%PLinVelEQ,2), UBOUND(InData%PLinVelEQ,2) + DO i1 = LBOUND(InData%PLinVelEQ,1), UBOUND(InData%PLinVelEQ,1) + ReKiBuf(Re_Xferred) = InData%PLinVelEQ(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PLinVelEU) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11683,8 +11743,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEU,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PLinVelEU)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PLinVelEU))-1 ) = PACK(InData%PLinVelEU,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PLinVelEU) + DO i3 = LBOUND(InData%PLinVelEU,3), UBOUND(InData%PLinVelEU,3) + DO i2 = LBOUND(InData%PLinVelEU,2), UBOUND(InData%PLinVelEU,2) + DO i1 = LBOUND(InData%PLinVelEU,1), UBOUND(InData%PLinVelEU,1) + ReKiBuf(Re_Xferred) = InData%PLinVelEU(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PLinVelEV) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11702,8 +11768,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEV,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PLinVelEV)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PLinVelEV))-1 ) = PACK(InData%PLinVelEV,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PLinVelEV) + DO i3 = LBOUND(InData%PLinVelEV,3), UBOUND(InData%PLinVelEV,3) + DO i2 = LBOUND(InData%PLinVelEV,2), UBOUND(InData%PLinVelEV,2) + DO i1 = LBOUND(InData%PLinVelEV,1), UBOUND(InData%PLinVelEV,1) + ReKiBuf(Re_Xferred) = InData%PLinVelEV(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PLinVelEW) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11721,8 +11793,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEW,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PLinVelEW)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PLinVelEW))-1 ) = PACK(InData%PLinVelEW,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PLinVelEW) + DO i3 = LBOUND(InData%PLinVelEW,3), UBOUND(InData%PLinVelEW,3) + DO i2 = LBOUND(InData%PLinVelEW,2), UBOUND(InData%PLinVelEW,2) + DO i1 = LBOUND(InData%PLinVelEW,1), UBOUND(InData%PLinVelEW,1) + ReKiBuf(Re_Xferred) = InData%PLinVelEW(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PLinVelEY) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11740,13 +11818,23 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PLinVelEY,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PLinVelEY)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PLinVelEY))-1 ) = PACK(InData%PLinVelEY,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PLinVelEY) + DO i3 = LBOUND(InData%PLinVelEY,3), UBOUND(InData%PLinVelEY,3) + DO i2 = LBOUND(InData%PLinVelEY,2), UBOUND(InData%PLinVelEY,2) + DO i1 = LBOUND(InData%PLinVelEY,1), UBOUND(InData%PLinVelEY,1) + ReKiBuf(Re_Xferred) = InData%PLinVelEY(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LinAccEIMUt))-1 ) = PACK(InData%LinAccEIMUt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LinAccEIMUt) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LinAccEOt))-1 ) = PACK(InData%LinAccEOt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LinAccEOt) + DO i1 = LBOUND(InData%LinAccEIMUt,1), UBOUND(InData%LinAccEIMUt,1) + ReKiBuf(Re_Xferred) = InData%LinAccEIMUt(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%LinAccEOt,1), UBOUND(InData%LinAccEOt,1) + ReKiBuf(Re_Xferred) = InData%LinAccEOt(i1) + Re_Xferred = Re_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%LinAccESt) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -11763,8 +11851,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinAccESt,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LinAccESt)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LinAccESt))-1 ) = PACK(InData%LinAccESt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LinAccESt) + DO i3 = LBOUND(InData%LinAccESt,3), UBOUND(InData%LinAccESt,3) + DO i2 = LBOUND(InData%LinAccESt,2), UBOUND(InData%LinAccESt,2) + DO i1 = LBOUND(InData%LinAccESt,1), UBOUND(InData%LinAccESt,1) + ReKiBuf(Re_Xferred) = InData%LinAccESt(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%LinAccETt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11779,21 +11873,37 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinAccETt,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LinAccETt)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LinAccETt))-1 ) = PACK(InData%LinAccETt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LinAccETt) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LinAccEZt))-1 ) = PACK(InData%LinAccEZt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LinAccEZt) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LinVelEIMU))-1 ) = PACK(InData%LinVelEIMU,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LinVelEIMU) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LinVelEZ))-1 ) = PACK(InData%LinVelEZ,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LinVelEZ) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LinVelEO))-1 ) = PACK(InData%LinVelEO,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LinVelEO) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FrcONcRtt))-1 ) = PACK(InData%FrcONcRtt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FrcONcRtt) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FrcPRott))-1 ) = PACK(InData%FrcPRott,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FrcPRott) + DO i2 = LBOUND(InData%LinAccETt,2), UBOUND(InData%LinAccETt,2) + DO i1 = LBOUND(InData%LinAccETt,1), UBOUND(InData%LinAccETt,1) + ReKiBuf(Re_Xferred) = InData%LinAccETt(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + DO i1 = LBOUND(InData%LinAccEZt,1), UBOUND(InData%LinAccEZt,1) + ReKiBuf(Re_Xferred) = InData%LinAccEZt(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%LinVelEIMU,1), UBOUND(InData%LinVelEIMU,1) + ReKiBuf(Re_Xferred) = InData%LinVelEIMU(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%LinVelEZ,1), UBOUND(InData%LinVelEZ,1) + ReKiBuf(Re_Xferred) = InData%LinVelEZ(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%LinVelEO,1), UBOUND(InData%LinVelEO,1) + ReKiBuf(Re_Xferred) = InData%LinVelEO(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%FrcONcRtt,1), UBOUND(InData%FrcONcRtt,1) + ReKiBuf(Re_Xferred) = InData%FrcONcRtt(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%FrcPRott,1), UBOUND(InData%FrcPRott,1) + ReKiBuf(Re_Xferred) = InData%FrcPRott(i1) + Re_Xferred = Re_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%FrcS0Bt) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -11807,11 +11917,17 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FrcS0Bt,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FrcS0Bt)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FrcS0Bt))-1 ) = PACK(InData%FrcS0Bt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FrcS0Bt) + DO i2 = LBOUND(InData%FrcS0Bt,2), UBOUND(InData%FrcS0Bt,2) + DO i1 = LBOUND(InData%FrcS0Bt,1), UBOUND(InData%FrcS0Bt,1) + ReKiBuf(Re_Xferred) = InData%FrcS0Bt(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FrcT0Trbt))-1 ) = PACK(InData%FrcT0Trbt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FrcT0Trbt) + DO i1 = LBOUND(InData%FrcT0Trbt,1), UBOUND(InData%FrcT0Trbt,1) + ReKiBuf(Re_Xferred) = InData%FrcT0Trbt(i1) + Re_Xferred = Re_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%FSAero) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -11828,8 +11944,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FSAero,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FSAero)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FSAero))-1 ) = PACK(InData%FSAero,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FSAero) + DO i3 = LBOUND(InData%FSAero,3), UBOUND(InData%FSAero,3) + DO i2 = LBOUND(InData%FSAero,2), UBOUND(InData%FSAero,2) + DO i1 = LBOUND(InData%FSAero,1), UBOUND(InData%FSAero,1) + ReKiBuf(Re_Xferred) = InData%FSAero(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%FSTipDrag) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11844,8 +11966,12 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FSTipDrag,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FSTipDrag)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FSTipDrag))-1 ) = PACK(InData%FSTipDrag,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FSTipDrag) + DO i2 = LBOUND(InData%FSTipDrag,2), UBOUND(InData%FSTipDrag,2) + DO i1 = LBOUND(InData%FSTipDrag,1), UBOUND(InData%FSTipDrag,1) + ReKiBuf(Re_Xferred) = InData%FSTipDrag(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%FTHydrot) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11860,11 +11986,17 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FTHydrot,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FTHydrot)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FTHydrot))-1 ) = PACK(InData%FTHydrot,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FTHydrot) + DO i2 = LBOUND(InData%FTHydrot,2), UBOUND(InData%FTHydrot,2) + DO i1 = LBOUND(InData%FTHydrot,1), UBOUND(InData%FTHydrot,1) + ReKiBuf(Re_Xferred) = InData%FTHydrot(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FZHydrot))-1 ) = PACK(InData%FZHydrot,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FZHydrot) + DO i1 = LBOUND(InData%FZHydrot,1), UBOUND(InData%FZHydrot,1) + ReKiBuf(Re_Xferred) = InData%FZHydrot(i1) + Re_Xferred = Re_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%MFHydrot) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -11878,11 +12010,17 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MFHydrot,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%MFHydrot)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MFHydrot))-1 ) = PACK(InData%MFHydrot,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MFHydrot) + DO i2 = LBOUND(InData%MFHydrot,2), UBOUND(InData%MFHydrot,2) + DO i1 = LBOUND(InData%MFHydrot,1), UBOUND(InData%MFHydrot,1) + ReKiBuf(Re_Xferred) = InData%MFHydrot(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MomBNcRtt))-1 ) = PACK(InData%MomBNcRtt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MomBNcRtt) + DO i1 = LBOUND(InData%MomBNcRtt,1), UBOUND(InData%MomBNcRtt,1) + ReKiBuf(Re_Xferred) = InData%MomBNcRtt(i1) + Re_Xferred = Re_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%MomH0Bt) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -11896,17 +12034,29 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MomH0Bt,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%MomH0Bt)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MomH0Bt))-1 ) = PACK(InData%MomH0Bt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MomH0Bt) + DO i2 = LBOUND(InData%MomH0Bt,2), UBOUND(InData%MomH0Bt,2) + DO i1 = LBOUND(InData%MomH0Bt,1), UBOUND(InData%MomH0Bt,1) + ReKiBuf(Re_Xferred) = InData%MomH0Bt(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MomLPRott))-1 ) = PACK(InData%MomLPRott,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MomLPRott) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MomNGnRtt))-1 ) = PACK(InData%MomNGnRtt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MomNGnRtt) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MomNTailt))-1 ) = PACK(InData%MomNTailt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MomNTailt) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MomX0Trbt))-1 ) = PACK(InData%MomX0Trbt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MomX0Trbt) + DO i1 = LBOUND(InData%MomLPRott,1), UBOUND(InData%MomLPRott,1) + ReKiBuf(Re_Xferred) = InData%MomLPRott(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%MomNGnRtt,1), UBOUND(InData%MomNGnRtt,1) + ReKiBuf(Re_Xferred) = InData%MomNGnRtt(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%MomNTailt,1), UBOUND(InData%MomNTailt,1) + ReKiBuf(Re_Xferred) = InData%MomNTailt(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%MomX0Trbt,1), UBOUND(InData%MomX0Trbt,1) + ReKiBuf(Re_Xferred) = InData%MomX0Trbt(i1) + Re_Xferred = Re_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%MMAero) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -11923,11 +12073,19 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MMAero,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%MMAero)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MMAero))-1 ) = PACK(InData%MMAero,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MMAero) + DO i3 = LBOUND(InData%MMAero,3), UBOUND(InData%MMAero,3) + DO i2 = LBOUND(InData%MMAero,2), UBOUND(InData%MMAero,2) + DO i1 = LBOUND(InData%MMAero,1), UBOUND(InData%MMAero,1) + ReKiBuf(Re_Xferred) = InData%MMAero(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MXHydrot))-1 ) = PACK(InData%MXHydrot,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MXHydrot) + DO i1 = LBOUND(InData%MXHydrot,1), UBOUND(InData%MXHydrot,1) + ReKiBuf(Re_Xferred) = InData%MXHydrot(i1) + Re_Xferred = Re_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%PFrcONcRt) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -11941,8 +12099,12 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFrcONcRt,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PFrcONcRt)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PFrcONcRt))-1 ) = PACK(InData%PFrcONcRt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PFrcONcRt) + DO i2 = LBOUND(InData%PFrcONcRt,2), UBOUND(InData%PFrcONcRt,2) + DO i1 = LBOUND(InData%PFrcONcRt,1), UBOUND(InData%PFrcONcRt,1) + ReKiBuf(Re_Xferred) = InData%PFrcONcRt(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PFrcPRot) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11957,8 +12119,12 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFrcPRot,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PFrcPRot)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PFrcPRot))-1 ) = PACK(InData%PFrcPRot,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PFrcPRot) + DO i2 = LBOUND(InData%PFrcPRot,2), UBOUND(InData%PFrcPRot,2) + DO i1 = LBOUND(InData%PFrcPRot,1), UBOUND(InData%PFrcPRot,1) + ReKiBuf(Re_Xferred) = InData%PFrcPRot(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PFrcS0B) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11976,8 +12142,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFrcS0B,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PFrcS0B)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PFrcS0B))-1 ) = PACK(InData%PFrcS0B,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PFrcS0B) + DO i3 = LBOUND(InData%PFrcS0B,3), UBOUND(InData%PFrcS0B,3) + DO i2 = LBOUND(InData%PFrcS0B,2), UBOUND(InData%PFrcS0B,2) + DO i1 = LBOUND(InData%PFrcS0B,1), UBOUND(InData%PFrcS0B,1) + ReKiBuf(Re_Xferred) = InData%PFrcS0B(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PFrcT0Trb) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -11992,8 +12164,12 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFrcT0Trb,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PFrcT0Trb)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PFrcT0Trb))-1 ) = PACK(InData%PFrcT0Trb,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PFrcT0Trb) + DO i2 = LBOUND(InData%PFrcT0Trb,2), UBOUND(InData%PFrcT0Trb,2) + DO i1 = LBOUND(InData%PFrcT0Trb,1), UBOUND(InData%PFrcT0Trb,1) + ReKiBuf(Re_Xferred) = InData%PFrcT0Trb(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PFTHydro) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -12011,11 +12187,21 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFTHydro,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PFTHydro)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PFTHydro))-1 ) = PACK(InData%PFTHydro,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PFTHydro) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PFZHydro))-1 ) = PACK(InData%PFZHydro,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PFZHydro) + DO i3 = LBOUND(InData%PFTHydro,3), UBOUND(InData%PFTHydro,3) + DO i2 = LBOUND(InData%PFTHydro,2), UBOUND(InData%PFTHydro,2) + DO i1 = LBOUND(InData%PFTHydro,1), UBOUND(InData%PFTHydro,1) + ReKiBuf(Re_Xferred) = InData%PFTHydro(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + DO i2 = LBOUND(InData%PFZHydro,2), UBOUND(InData%PFZHydro,2) + DO i1 = LBOUND(InData%PFZHydro,1), UBOUND(InData%PFZHydro,1) + ReKiBuf(Re_Xferred) = InData%PFZHydro(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO IF ( .NOT. ALLOCATED(InData%PMFHydro) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -12032,8 +12218,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMFHydro,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PMFHydro)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PMFHydro))-1 ) = PACK(InData%PMFHydro,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PMFHydro) + DO i3 = LBOUND(InData%PMFHydro,3), UBOUND(InData%PMFHydro,3) + DO i2 = LBOUND(InData%PMFHydro,2), UBOUND(InData%PMFHydro,2) + DO i1 = LBOUND(InData%PMFHydro,1), UBOUND(InData%PMFHydro,1) + ReKiBuf(Re_Xferred) = InData%PMFHydro(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PMomBNcRt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -12048,8 +12240,12 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMomBNcRt,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PMomBNcRt)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PMomBNcRt))-1 ) = PACK(InData%PMomBNcRt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PMomBNcRt) + DO i2 = LBOUND(InData%PMomBNcRt,2), UBOUND(InData%PMomBNcRt,2) + DO i1 = LBOUND(InData%PMomBNcRt,1), UBOUND(InData%PMomBNcRt,1) + ReKiBuf(Re_Xferred) = InData%PMomBNcRt(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PMomH0B) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -12067,8 +12263,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMomH0B,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PMomH0B)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PMomH0B))-1 ) = PACK(InData%PMomH0B,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PMomH0B) + DO i3 = LBOUND(InData%PMomH0B,3), UBOUND(InData%PMomH0B,3) + DO i2 = LBOUND(InData%PMomH0B,2), UBOUND(InData%PMomH0B,2) + DO i1 = LBOUND(InData%PMomH0B,1), UBOUND(InData%PMomH0B,1) + ReKiBuf(Re_Xferred) = InData%PMomH0B(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PMomLPRot) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -12083,8 +12285,12 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMomLPRot,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PMomLPRot)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PMomLPRot))-1 ) = PACK(InData%PMomLPRot,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PMomLPRot) + DO i2 = LBOUND(InData%PMomLPRot,2), UBOUND(InData%PMomLPRot,2) + DO i1 = LBOUND(InData%PMomLPRot,1), UBOUND(InData%PMomLPRot,1) + ReKiBuf(Re_Xferred) = InData%PMomLPRot(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PMomNGnRt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -12099,8 +12305,12 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMomNGnRt,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PMomNGnRt)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PMomNGnRt))-1 ) = PACK(InData%PMomNGnRt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PMomNGnRt) + DO i2 = LBOUND(InData%PMomNGnRt,2), UBOUND(InData%PMomNGnRt,2) + DO i1 = LBOUND(InData%PMomNGnRt,1), UBOUND(InData%PMomNGnRt,1) + ReKiBuf(Re_Xferred) = InData%PMomNGnRt(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PMomNTail) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -12115,8 +12325,12 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMomNTail,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PMomNTail)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PMomNTail))-1 ) = PACK(InData%PMomNTail,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PMomNTail) + DO i2 = LBOUND(InData%PMomNTail,2), UBOUND(InData%PMomNTail,2) + DO i1 = LBOUND(InData%PMomNTail,1), UBOUND(InData%PMomNTail,1) + ReKiBuf(Re_Xferred) = InData%PMomNTail(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PMomX0Trb) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -12131,21 +12345,37 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMomX0Trb,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PMomX0Trb)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PMomX0Trb))-1 ) = PACK(InData%PMomX0Trb,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PMomX0Trb) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PMXHydro))-1 ) = PACK(InData%PMXHydro,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PMXHydro) - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%TeetAng - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FrcVGnRtt))-1 ) = PACK(InData%FrcVGnRtt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FrcVGnRtt) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FrcWTailt))-1 ) = PACK(InData%FrcWTailt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FrcWTailt) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FrcZAllt))-1 ) = PACK(InData%FrcZAllt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FrcZAllt) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MomXAllt))-1 ) = PACK(InData%MomXAllt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MomXAllt) + DO i2 = LBOUND(InData%PMomX0Trb,2), UBOUND(InData%PMomX0Trb,2) + DO i1 = LBOUND(InData%PMomX0Trb,1), UBOUND(InData%PMomX0Trb,1) + ReKiBuf(Re_Xferred) = InData%PMomX0Trb(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + DO i2 = LBOUND(InData%PMXHydro,2), UBOUND(InData%PMXHydro,2) + DO i1 = LBOUND(InData%PMXHydro,1), UBOUND(InData%PMXHydro,1) + ReKiBuf(Re_Xferred) = InData%PMXHydro(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DbKiBuf(Db_Xferred) = InData%TeetAng + Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(InData%FrcVGnRtt,1), UBOUND(InData%FrcVGnRtt,1) + ReKiBuf(Re_Xferred) = InData%FrcVGnRtt(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%FrcWTailt,1), UBOUND(InData%FrcWTailt,1) + ReKiBuf(Re_Xferred) = InData%FrcWTailt(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%FrcZAllt,1), UBOUND(InData%FrcZAllt,1) + ReKiBuf(Re_Xferred) = InData%FrcZAllt(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%MomXAllt,1), UBOUND(InData%MomXAllt,1) + ReKiBuf(Re_Xferred) = InData%MomXAllt(i1) + Re_Xferred = Re_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%PFrcVGnRt) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -12159,8 +12389,12 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFrcVGnRt,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PFrcVGnRt)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PFrcVGnRt))-1 ) = PACK(InData%PFrcVGnRt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PFrcVGnRt) + DO i2 = LBOUND(InData%PFrcVGnRt,2), UBOUND(InData%PFrcVGnRt,2) + DO i1 = LBOUND(InData%PFrcVGnRt,1), UBOUND(InData%PFrcVGnRt,1) + ReKiBuf(Re_Xferred) = InData%PFrcVGnRt(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PFrcWTail) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -12175,8 +12409,12 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFrcWTail,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PFrcWTail)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PFrcWTail))-1 ) = PACK(InData%PFrcWTail,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PFrcWTail) + DO i2 = LBOUND(InData%PFrcWTail,2), UBOUND(InData%PFrcWTail,2) + DO i1 = LBOUND(InData%PFrcWTail,1), UBOUND(InData%PFrcWTail,1) + ReKiBuf(Re_Xferred) = InData%PFrcWTail(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PFrcZAll) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -12191,8 +12429,12 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PFrcZAll,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PFrcZAll)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PFrcZAll))-1 ) = PACK(InData%PFrcZAll,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PFrcZAll) + DO i2 = LBOUND(InData%PFrcZAll,2), UBOUND(InData%PFrcZAll,2) + DO i1 = LBOUND(InData%PFrcZAll,1), UBOUND(InData%PFrcZAll,1) + ReKiBuf(Re_Xferred) = InData%PFrcZAll(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PMomXAll) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -12207,17 +12449,21 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PMomXAll,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PMomXAll)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PMomXAll))-1 ) = PACK(InData%PMomXAll,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PMomXAll) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TeetMom - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlMom - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlMom - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GBoxEffFac - Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(InData%PMomXAll,2), UBOUND(InData%PMomXAll,2) + DO i1 = LBOUND(InData%PMomXAll,1), UBOUND(InData%PMomXAll,1) + ReKiBuf(Re_Xferred) = InData%PMomXAll(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + ReKiBuf(Re_Xferred) = InData%TeetMom + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlMom + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlMom + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GBoxEffFac + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%rSAerCen) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -12234,8 +12480,14 @@ SUBROUTINE ED_PackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rSAerCen,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%rSAerCen)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%rSAerCen))-1 ) = PACK(InData%rSAerCen,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%rSAerCen) + DO i3 = LBOUND(InData%rSAerCen,3), UBOUND(InData%rSAerCen,3) + DO i2 = LBOUND(InData%rSAerCen,2), UBOUND(InData%rSAerCen,2) + DO i1 = LBOUND(InData%rSAerCen,1), UBOUND(InData%rSAerCen,1) + ReKiBuf(Re_Xferred) = InData%rSAerCen(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF END SUBROUTINE ED_PackRtHndSide @@ -12252,12 +12504,6 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (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 @@ -12278,15 +12524,10 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Int_Xferred = 1 i1_l = LBOUND(OutData%rO,1) i1_u = UBOUND(OutData%rO,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rO = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rO))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rO) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rO,1), UBOUND(OutData%rO,1) + OutData%rO(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rQS not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -12306,15 +12547,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rQS.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%rQS)>0) OutData%rQS = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rQS))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rQS) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%rQS,3), UBOUND(OutData%rQS,3) + DO i2 = LBOUND(OutData%rQS,2), UBOUND(OutData%rQS,2) + DO i1 = LBOUND(OutData%rQS,1), UBOUND(OutData%rQS,1) + OutData%rQS(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rS not allocated Int_Xferred = Int_Xferred + 1 @@ -12335,15 +12575,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rS.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%rS)>0) OutData%rS = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rS))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rS) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%rS,3), UBOUND(OutData%rS,3) + DO i2 = LBOUND(OutData%rS,2), UBOUND(OutData%rS,2) + DO i1 = LBOUND(OutData%rS,1), UBOUND(OutData%rS,1) + OutData%rS(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rS0S not allocated Int_Xferred = Int_Xferred + 1 @@ -12364,15 +12603,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rS0S.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%rS0S)>0) OutData%rS0S = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rS0S))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rS0S) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%rS0S,3), UBOUND(OutData%rS0S,3) + DO i2 = LBOUND(OutData%rS0S,2), UBOUND(OutData%rS0S,2) + DO i1 = LBOUND(OutData%rS0S,1), UBOUND(OutData%rS0S,1) + OutData%rS0S(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rT not allocated Int_Xferred = Int_Xferred + 1 @@ -12390,27 +12628,19 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rT.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%rT)>0) OutData%rT = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rT))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rT) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%rT,2), UBOUND(OutData%rT,2) + DO i1 = LBOUND(OutData%rT,1), UBOUND(OutData%rT,1) + OutData%rT(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF i1_l = LBOUND(OutData%rT0O,1) i1_u = UBOUND(OutData%rT0O,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rT0O = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rT0O))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rT0O) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rT0O,1), UBOUND(OutData%rT0O,1) + OutData%rT0O(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rT0T not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -12427,38 +12657,25 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rT0T.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%rT0T)>0) OutData%rT0T = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rT0T))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rT0T) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%rT0T,2), UBOUND(OutData%rT0T,2) + DO i1 = LBOUND(OutData%rT0T,1), UBOUND(OutData%rT0T,1) + OutData%rT0T(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF i1_l = LBOUND(OutData%rZ,1) i1_u = UBOUND(OutData%rZ,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rZ = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rZ))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rZ) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rZ,1), UBOUND(OutData%rZ,1) + OutData%rZ(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%rZO,1) i1_u = UBOUND(OutData%rZO,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rZO = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rZO))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rZO) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rZO,1), UBOUND(OutData%rZO,1) + OutData%rZO(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rZT not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -12475,115 +12692,67 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rZT.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%rZT)>0) OutData%rZT = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rZT))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rZT) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%rZT,2), UBOUND(OutData%rZT,2) + DO i1 = LBOUND(OutData%rZT,1), UBOUND(OutData%rZT,1) + OutData%rZT(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF i1_l = LBOUND(OutData%rPQ,1) i1_u = UBOUND(OutData%rPQ,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rPQ = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rPQ))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rPQ) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rPQ,1), UBOUND(OutData%rPQ,1) + OutData%rPQ(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%rP,1) i1_u = UBOUND(OutData%rP,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rP = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rP))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rP) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rP,1), UBOUND(OutData%rP,1) + OutData%rP(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%rV,1) i1_u = UBOUND(OutData%rV,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rV = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rV))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rV) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rV,1), UBOUND(OutData%rV,1) + OutData%rV(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%rZY,1) i1_u = UBOUND(OutData%rZY,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rZY = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rZY))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rZY) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rZY,1), UBOUND(OutData%rZY,1) + OutData%rZY(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%rOU,1) i1_u = UBOUND(OutData%rOU,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rOU = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rOU))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rOU) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rOU,1), UBOUND(OutData%rOU,1) + OutData%rOU(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%rOV,1) i1_u = UBOUND(OutData%rOV,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rOV = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rOV))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rOV) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rOV,1), UBOUND(OutData%rOV,1) + OutData%rOV(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%rVD,1) i1_u = UBOUND(OutData%rVD,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rVD = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rVD))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rVD) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rVD,1), UBOUND(OutData%rVD,1) + OutData%rVD(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%rOW,1) i1_u = UBOUND(OutData%rOW,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rOW = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rOW))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rOW) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rOW,1), UBOUND(OutData%rOW,1) + OutData%rOW(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%rPC,1) i1_u = UBOUND(OutData%rPC,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rPC = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rPC))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rPC) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rPC,1), UBOUND(OutData%rPC,1) + OutData%rPC(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rPS0 not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -12600,104 +12769,61 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rPS0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%rPS0)>0) OutData%rPS0 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rPS0))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rPS0) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%rPS0,2), UBOUND(OutData%rPS0,2) + DO i1 = LBOUND(OutData%rPS0,1), UBOUND(OutData%rPS0,1) + OutData%rPS0(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF i1_l = LBOUND(OutData%rQ,1) i1_u = UBOUND(OutData%rQ,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rQ = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rQ))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rQ) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rQ,1), UBOUND(OutData%rQ,1) + OutData%rQ(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%rQC,1) i1_u = UBOUND(OutData%rQC,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rQC = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rQC))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rQC) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rQC,1), UBOUND(OutData%rQC,1) + OutData%rQC(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%rVIMU,1) i1_u = UBOUND(OutData%rVIMU,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rVIMU = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rVIMU))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rVIMU) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rVIMU,1), UBOUND(OutData%rVIMU,1) + OutData%rVIMU(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%rVP,1) i1_u = UBOUND(OutData%rVP,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rVP = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rVP))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rVP) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rVP,1), UBOUND(OutData%rVP,1) + OutData%rVP(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%rWI,1) i1_u = UBOUND(OutData%rWI,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rWI = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rWI))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rWI) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rWI,1), UBOUND(OutData%rWI,1) + OutData%rWI(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%rWJ,1) i1_u = UBOUND(OutData%rWJ,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rWJ = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rWJ))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rWJ) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rWJ,1), UBOUND(OutData%rWJ,1) + OutData%rWJ(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%rWK,1) i1_u = UBOUND(OutData%rWK,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rWK = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rWK))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rWK) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rWK,1), UBOUND(OutData%rWK,1) + OutData%rWK(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%rZT0,1) i1_u = UBOUND(OutData%rZT0,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rZT0 = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%rZT0))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%rZT0) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rZT0,1), UBOUND(OutData%rZT0,1) + OutData%rZT0(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AngPosEF not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -12714,15 +12840,12 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngPosEF.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%AngPosEF)>0) OutData%AngPosEF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AngPosEF))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AngPosEF) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AngPosEF,2), UBOUND(OutData%AngPosEF,2) + DO i1 = LBOUND(OutData%AngPosEF,1), UBOUND(OutData%AngPosEF,1) + OutData%AngPosEF(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AngPosXF not allocated Int_Xferred = Int_Xferred + 1 @@ -12740,15 +12863,12 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngPosXF.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%AngPosXF)>0) OutData%AngPosXF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AngPosXF))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AngPosXF) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AngPosXF,2), UBOUND(OutData%AngPosXF,2) + DO i1 = LBOUND(OutData%AngPosXF,1), UBOUND(OutData%AngPosXF,1) + OutData%AngPosXF(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AngPosHM not allocated Int_Xferred = Int_Xferred + 1 @@ -12769,38 +12889,27 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngPosHM.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%AngPosHM)>0) OutData%AngPosHM = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AngPosHM))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AngPosHM) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%AngPosHM,3), UBOUND(OutData%AngPosHM,3) + DO i2 = LBOUND(OutData%AngPosHM,2), UBOUND(OutData%AngPosHM,2) + DO i1 = LBOUND(OutData%AngPosHM,1), UBOUND(OutData%AngPosHM,1) + OutData%AngPosHM(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF i1_l = LBOUND(OutData%AngPosXB,1) i1_u = UBOUND(OutData%AngPosXB,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%AngPosXB = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AngPosXB))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AngPosXB) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AngPosXB,1), UBOUND(OutData%AngPosXB,1) + OutData%AngPosXB(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%AngPosEX,1) i1_u = UBOUND(OutData%AngPosEX,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%AngPosEX = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AngPosEX))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AngPosEX) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AngPosEX,1), UBOUND(OutData%AngPosEX,1) + OutData%AngPosEX(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PAngVelEA not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -12820,15 +12929,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelEA.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PAngVelEA)>0) OutData%PAngVelEA = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PAngVelEA))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PAngVelEA) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PAngVelEA,3), UBOUND(OutData%PAngVelEA,3) + DO i2 = LBOUND(OutData%PAngVelEA,2), UBOUND(OutData%PAngVelEA,2) + DO i1 = LBOUND(OutData%PAngVelEA,1), UBOUND(OutData%PAngVelEA,1) + OutData%PAngVelEA(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PAngVelEF not allocated Int_Xferred = Int_Xferred + 1 @@ -12852,15 +12960,16 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelEF.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%PAngVelEF)>0) OutData%PAngVelEF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PAngVelEF))-1 ), mask4, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PAngVelEF) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%PAngVelEF,4), UBOUND(OutData%PAngVelEF,4) + DO i3 = LBOUND(OutData%PAngVelEF,3), UBOUND(OutData%PAngVelEF,3) + DO i2 = LBOUND(OutData%PAngVelEF,2), UBOUND(OutData%PAngVelEF,2) + DO i1 = LBOUND(OutData%PAngVelEF,1), UBOUND(OutData%PAngVelEF,1) + OutData%PAngVelEF(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PAngVelEG not allocated Int_Xferred = Int_Xferred + 1 @@ -12881,15 +12990,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelEG.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PAngVelEG)>0) OutData%PAngVelEG = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PAngVelEG))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PAngVelEG) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PAngVelEG,3), UBOUND(OutData%PAngVelEG,3) + DO i2 = LBOUND(OutData%PAngVelEG,2), UBOUND(OutData%PAngVelEG,2) + DO i1 = LBOUND(OutData%PAngVelEG,1), UBOUND(OutData%PAngVelEG,1) + OutData%PAngVelEG(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PAngVelEH not allocated Int_Xferred = Int_Xferred + 1 @@ -12910,15 +13018,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelEH.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PAngVelEH)>0) OutData%PAngVelEH = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PAngVelEH))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PAngVelEH) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PAngVelEH,3), UBOUND(OutData%PAngVelEH,3) + DO i2 = LBOUND(OutData%PAngVelEH,2), UBOUND(OutData%PAngVelEH,2) + DO i1 = LBOUND(OutData%PAngVelEH,1), UBOUND(OutData%PAngVelEH,1) + OutData%PAngVelEH(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PAngVelEL not allocated Int_Xferred = Int_Xferred + 1 @@ -12939,15 +13046,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelEL.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PAngVelEL)>0) OutData%PAngVelEL = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PAngVelEL))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PAngVelEL) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PAngVelEL,3), UBOUND(OutData%PAngVelEL,3) + DO i2 = LBOUND(OutData%PAngVelEL,2), UBOUND(OutData%PAngVelEL,2) + DO i1 = LBOUND(OutData%PAngVelEL,1), UBOUND(OutData%PAngVelEL,1) + OutData%PAngVelEL(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PAngVelEM not allocated Int_Xferred = Int_Xferred + 1 @@ -12974,15 +13080,18 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelEM.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask5(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask5.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask5 = .TRUE. - IF (SIZE(OutData%PAngVelEM)>0) OutData%PAngVelEM = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PAngVelEM))-1 ), mask5, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PAngVelEM) - DEALLOCATE(mask5) + DO i5 = LBOUND(OutData%PAngVelEM,5), UBOUND(OutData%PAngVelEM,5) + DO i4 = LBOUND(OutData%PAngVelEM,4), UBOUND(OutData%PAngVelEM,4) + DO i3 = LBOUND(OutData%PAngVelEM,3), UBOUND(OutData%PAngVelEM,3) + DO i2 = LBOUND(OutData%PAngVelEM,2), UBOUND(OutData%PAngVelEM,2) + DO i1 = LBOUND(OutData%PAngVelEM,1), UBOUND(OutData%PAngVelEM,1) + OutData%PAngVelEM(i1,i2,i3,i4,i5) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AngVelEM not allocated Int_Xferred = Int_Xferred + 1 @@ -13003,15 +13112,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngVelEM.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%AngVelEM)>0) OutData%AngVelEM = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AngVelEM))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AngVelEM) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%AngVelEM,3), UBOUND(OutData%AngVelEM,3) + DO i2 = LBOUND(OutData%AngVelEM,2), UBOUND(OutData%AngVelEM,2) + DO i1 = LBOUND(OutData%AngVelEM,1), UBOUND(OutData%AngVelEM,1) + OutData%AngVelEM(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PAngVelEN not allocated Int_Xferred = Int_Xferred + 1 @@ -13032,27 +13140,21 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelEN.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PAngVelEN)>0) OutData%PAngVelEN = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PAngVelEN))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PAngVelEN) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PAngVelEN,3), UBOUND(OutData%PAngVelEN,3) + DO i2 = LBOUND(OutData%PAngVelEN,2), UBOUND(OutData%PAngVelEN,2) + DO i1 = LBOUND(OutData%PAngVelEN,1), UBOUND(OutData%PAngVelEN,1) + OutData%PAngVelEN(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF i1_l = LBOUND(OutData%AngVelEA,1) i1_u = UBOUND(OutData%AngVelEA,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%AngVelEA = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AngVelEA))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AngVelEA) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AngVelEA,1), UBOUND(OutData%AngVelEA,1) + OutData%AngVelEA(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PAngVelEB not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -13072,15 +13174,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelEB.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PAngVelEB)>0) OutData%PAngVelEB = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PAngVelEB))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PAngVelEB) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PAngVelEB,3), UBOUND(OutData%PAngVelEB,3) + DO i2 = LBOUND(OutData%PAngVelEB,2), UBOUND(OutData%PAngVelEB,2) + DO i1 = LBOUND(OutData%PAngVelEB,1), UBOUND(OutData%PAngVelEB,1) + OutData%PAngVelEB(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PAngVelER not allocated Int_Xferred = Int_Xferred + 1 @@ -13101,15 +13202,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelER.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PAngVelER)>0) OutData%PAngVelER = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PAngVelER))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PAngVelER) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PAngVelER,3), UBOUND(OutData%PAngVelER,3) + DO i2 = LBOUND(OutData%PAngVelER,2), UBOUND(OutData%PAngVelER,2) + DO i1 = LBOUND(OutData%PAngVelER,1), UBOUND(OutData%PAngVelER,1) + OutData%PAngVelER(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PAngVelEX not allocated Int_Xferred = Int_Xferred + 1 @@ -13130,128 +13230,77 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PAngVelEX.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PAngVelEX)>0) OutData%PAngVelEX = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PAngVelEX))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PAngVelEX) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PAngVelEX,3), UBOUND(OutData%PAngVelEX,3) + DO i2 = LBOUND(OutData%PAngVelEX,2), UBOUND(OutData%PAngVelEX,2) + DO i1 = LBOUND(OutData%PAngVelEX,1), UBOUND(OutData%PAngVelEX,1) + OutData%PAngVelEX(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF i1_l = LBOUND(OutData%AngVelEG,1) i1_u = UBOUND(OutData%AngVelEG,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%AngVelEG = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AngVelEG))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AngVelEG) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AngVelEG,1), UBOUND(OutData%AngVelEG,1) + OutData%AngVelEG(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%AngVelEH,1) i1_u = UBOUND(OutData%AngVelEH,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%AngVelEH = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AngVelEH))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AngVelEH) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AngVelEH,1), UBOUND(OutData%AngVelEH,1) + OutData%AngVelEH(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%AngVelEL,1) i1_u = UBOUND(OutData%AngVelEL,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%AngVelEL = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AngVelEL))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AngVelEL) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AngVelEL,1), UBOUND(OutData%AngVelEL,1) + OutData%AngVelEL(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%AngVelEN,1) i1_u = UBOUND(OutData%AngVelEN,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%AngVelEN = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AngVelEN))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AngVelEN) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AngVelEN,1), UBOUND(OutData%AngVelEN,1) + OutData%AngVelEN(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%AngVelEB,1) i1_u = UBOUND(OutData%AngVelEB,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%AngVelEB = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AngVelEB))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AngVelEB) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AngVelEB,1), UBOUND(OutData%AngVelEB,1) + OutData%AngVelEB(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%AngVelER,1) i1_u = UBOUND(OutData%AngVelER,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%AngVelER = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AngVelER))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AngVelER) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AngVelER,1), UBOUND(OutData%AngVelER,1) + OutData%AngVelER(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%AngVelEX,1) i1_u = UBOUND(OutData%AngVelEX,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%AngVelEX = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AngVelEX))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AngVelEX) - DEALLOCATE(mask1) - OutData%TeetAngVel = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(OutData%AngVelEX,1), UBOUND(OutData%AngVelEX,1) + OutData%AngVelEX(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%TeetAngVel = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 i1_l = LBOUND(OutData%AngAccEBt,1) i1_u = UBOUND(OutData%AngAccEBt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%AngAccEBt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AngAccEBt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AngAccEBt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AngAccEBt,1), UBOUND(OutData%AngAccEBt,1) + OutData%AngAccEBt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%AngAccERt,1) i1_u = UBOUND(OutData%AngAccERt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%AngAccERt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AngAccERt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AngAccERt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AngAccERt,1), UBOUND(OutData%AngAccERt,1) + OutData%AngAccERt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%AngAccEXt,1) i1_u = UBOUND(OutData%AngAccEXt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%AngAccEXt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AngAccEXt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AngAccEXt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AngAccEXt,1), UBOUND(OutData%AngAccEXt,1) + OutData%AngAccEXt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AngAccEFt not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -13268,15 +13317,12 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngAccEFt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%AngAccEFt)>0) OutData%AngAccEFt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AngAccEFt))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AngAccEFt) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AngAccEFt,2), UBOUND(OutData%AngAccEFt,2) + DO i1 = LBOUND(OutData%AngAccEFt,1), UBOUND(OutData%AngAccEFt,1) + OutData%AngAccEFt(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AngVelEF not allocated Int_Xferred = Int_Xferred + 1 @@ -13294,126 +13340,73 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AngVelEF.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%AngVelEF)>0) OutData%AngVelEF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AngVelEF))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AngVelEF) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AngVelEF,2), UBOUND(OutData%AngVelEF,2) + DO i1 = LBOUND(OutData%AngVelEF,1), UBOUND(OutData%AngVelEF,1) + OutData%AngVelEF(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF i1_l = LBOUND(OutData%AngAccEAt,1) i1_u = UBOUND(OutData%AngAccEAt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%AngAccEAt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AngAccEAt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AngAccEAt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AngAccEAt,1), UBOUND(OutData%AngAccEAt,1) + OutData%AngAccEAt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%AngAccEGt,1) i1_u = UBOUND(OutData%AngAccEGt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%AngAccEGt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AngAccEGt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AngAccEGt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AngAccEGt,1), UBOUND(OutData%AngAccEGt,1) + OutData%AngAccEGt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%AngAccEHt,1) i1_u = UBOUND(OutData%AngAccEHt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%AngAccEHt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AngAccEHt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AngAccEHt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AngAccEHt,1), UBOUND(OutData%AngAccEHt,1) + OutData%AngAccEHt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%AngAccENt,1) i1_u = UBOUND(OutData%AngAccENt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%AngAccENt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AngAccENt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AngAccENt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AngAccENt,1), UBOUND(OutData%AngAccENt,1) + OutData%AngAccENt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%LinAccECt,1) i1_u = UBOUND(OutData%LinAccECt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%LinAccECt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LinAccECt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LinAccECt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LinAccECt,1), UBOUND(OutData%LinAccECt,1) + OutData%LinAccECt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%LinAccEDt,1) i1_u = UBOUND(OutData%LinAccEDt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%LinAccEDt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LinAccEDt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LinAccEDt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LinAccEDt,1), UBOUND(OutData%LinAccEDt,1) + OutData%LinAccEDt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%LinAccEIt,1) i1_u = UBOUND(OutData%LinAccEIt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%LinAccEIt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LinAccEIt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LinAccEIt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LinAccEIt,1), UBOUND(OutData%LinAccEIt,1) + OutData%LinAccEIt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%LinAccEJt,1) i1_u = UBOUND(OutData%LinAccEJt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%LinAccEJt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LinAccEJt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LinAccEJt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LinAccEJt,1), UBOUND(OutData%LinAccEJt,1) + OutData%LinAccEJt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%LinAccEUt,1) i1_u = UBOUND(OutData%LinAccEUt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%LinAccEUt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LinAccEUt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LinAccEUt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LinAccEUt,1), UBOUND(OutData%LinAccEUt,1) + OutData%LinAccEUt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%LinAccEYt,1) i1_u = UBOUND(OutData%LinAccEYt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%LinAccEYt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LinAccEYt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LinAccEYt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LinAccEYt,1), UBOUND(OutData%LinAccEYt,1) + OutData%LinAccEYt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinVelES not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -13433,27 +13426,21 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinVelES.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%LinVelES)>0) OutData%LinVelES = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LinVelES))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LinVelES) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%LinVelES,3), UBOUND(OutData%LinVelES,3) + DO i2 = LBOUND(OutData%LinVelES,2), UBOUND(OutData%LinVelES,2) + DO i1 = LBOUND(OutData%LinVelES,1), UBOUND(OutData%LinVelES,1) + OutData%LinVelES(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF i1_l = LBOUND(OutData%LinVelEQ,1) i1_u = UBOUND(OutData%LinVelEQ,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%LinVelEQ = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LinVelEQ))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LinVelEQ) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LinVelEQ,1), UBOUND(OutData%LinVelEQ,1) + OutData%LinVelEQ(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinVelET not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -13470,15 +13457,12 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinVelET.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%LinVelET)>0) OutData%LinVelET = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LinVelET))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LinVelET) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%LinVelET,2), UBOUND(OutData%LinVelET,2) + DO i1 = LBOUND(OutData%LinVelET,1), UBOUND(OutData%LinVelET,1) + OutData%LinVelET(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinVelESm2 not allocated Int_Xferred = Int_Xferred + 1 @@ -13493,15 +13477,10 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinVelESm2.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LinVelESm2)>0) OutData%LinVelESm2 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LinVelESm2))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LinVelESm2) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LinVelESm2,1), UBOUND(OutData%LinVelESm2,1) + OutData%LinVelESm2(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelEIMU not allocated Int_Xferred = Int_Xferred + 1 @@ -13522,15 +13501,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEIMU.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PLinVelEIMU)>0) OutData%PLinVelEIMU = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PLinVelEIMU))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PLinVelEIMU) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PLinVelEIMU,3), UBOUND(OutData%PLinVelEIMU,3) + DO i2 = LBOUND(OutData%PLinVelEIMU,2), UBOUND(OutData%PLinVelEIMU,2) + DO i1 = LBOUND(OutData%PLinVelEIMU,1), UBOUND(OutData%PLinVelEIMU,1) + OutData%PLinVelEIMU(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelEO not allocated Int_Xferred = Int_Xferred + 1 @@ -13551,15 +13529,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEO.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PLinVelEO)>0) OutData%PLinVelEO = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PLinVelEO))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PLinVelEO) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PLinVelEO,3), UBOUND(OutData%PLinVelEO,3) + DO i2 = LBOUND(OutData%PLinVelEO,2), UBOUND(OutData%PLinVelEO,2) + DO i1 = LBOUND(OutData%PLinVelEO,1), UBOUND(OutData%PLinVelEO,1) + OutData%PLinVelEO(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelES not allocated Int_Xferred = Int_Xferred + 1 @@ -13586,15 +13563,18 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelES.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask5(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask5.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask5 = .TRUE. - IF (SIZE(OutData%PLinVelES)>0) OutData%PLinVelES = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PLinVelES))-1 ), mask5, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PLinVelES) - DEALLOCATE(mask5) + DO i5 = LBOUND(OutData%PLinVelES,5), UBOUND(OutData%PLinVelES,5) + DO i4 = LBOUND(OutData%PLinVelES,4), UBOUND(OutData%PLinVelES,4) + DO i3 = LBOUND(OutData%PLinVelES,3), UBOUND(OutData%PLinVelES,3) + DO i2 = LBOUND(OutData%PLinVelES,2), UBOUND(OutData%PLinVelES,2) + DO i1 = LBOUND(OutData%PLinVelES,1), UBOUND(OutData%PLinVelES,1) + OutData%PLinVelES(i1,i2,i3,i4,i5) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelET not allocated Int_Xferred = Int_Xferred + 1 @@ -13618,15 +13598,16 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelET.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%PLinVelET)>0) OutData%PLinVelET = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PLinVelET))-1 ), mask4, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PLinVelET) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%PLinVelET,4), UBOUND(OutData%PLinVelET,4) + DO i3 = LBOUND(OutData%PLinVelET,3), UBOUND(OutData%PLinVelET,3) + DO i2 = LBOUND(OutData%PLinVelET,2), UBOUND(OutData%PLinVelET,2) + DO i1 = LBOUND(OutData%PLinVelET,1), UBOUND(OutData%PLinVelET,1) + OutData%PLinVelET(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelEZ not allocated Int_Xferred = Int_Xferred + 1 @@ -13647,15 +13628,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEZ.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PLinVelEZ)>0) OutData%PLinVelEZ = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PLinVelEZ))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PLinVelEZ) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PLinVelEZ,3), UBOUND(OutData%PLinVelEZ,3) + DO i2 = LBOUND(OutData%PLinVelEZ,2), UBOUND(OutData%PLinVelEZ,2) + DO i1 = LBOUND(OutData%PLinVelEZ,1), UBOUND(OutData%PLinVelEZ,1) + OutData%PLinVelEZ(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelEC not allocated Int_Xferred = Int_Xferred + 1 @@ -13676,15 +13656,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEC.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PLinVelEC)>0) OutData%PLinVelEC = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PLinVelEC))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PLinVelEC) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PLinVelEC,3), UBOUND(OutData%PLinVelEC,3) + DO i2 = LBOUND(OutData%PLinVelEC,2), UBOUND(OutData%PLinVelEC,2) + DO i1 = LBOUND(OutData%PLinVelEC,1), UBOUND(OutData%PLinVelEC,1) + OutData%PLinVelEC(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelED not allocated Int_Xferred = Int_Xferred + 1 @@ -13705,15 +13684,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelED.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PLinVelED)>0) OutData%PLinVelED = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PLinVelED))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PLinVelED) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PLinVelED,3), UBOUND(OutData%PLinVelED,3) + DO i2 = LBOUND(OutData%PLinVelED,2), UBOUND(OutData%PLinVelED,2) + DO i1 = LBOUND(OutData%PLinVelED,1), UBOUND(OutData%PLinVelED,1) + OutData%PLinVelED(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelEI not allocated Int_Xferred = Int_Xferred + 1 @@ -13734,15 +13712,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEI.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PLinVelEI)>0) OutData%PLinVelEI = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PLinVelEI))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PLinVelEI) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PLinVelEI,3), UBOUND(OutData%PLinVelEI,3) + DO i2 = LBOUND(OutData%PLinVelEI,2), UBOUND(OutData%PLinVelEI,2) + DO i1 = LBOUND(OutData%PLinVelEI,1), UBOUND(OutData%PLinVelEI,1) + OutData%PLinVelEI(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelEJ not allocated Int_Xferred = Int_Xferred + 1 @@ -13763,15 +13740,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEJ.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PLinVelEJ)>0) OutData%PLinVelEJ = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PLinVelEJ))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PLinVelEJ) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PLinVelEJ,3), UBOUND(OutData%PLinVelEJ,3) + DO i2 = LBOUND(OutData%PLinVelEJ,2), UBOUND(OutData%PLinVelEJ,2) + DO i1 = LBOUND(OutData%PLinVelEJ,1), UBOUND(OutData%PLinVelEJ,1) + OutData%PLinVelEJ(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelEK not allocated Int_Xferred = Int_Xferred + 1 @@ -13792,15 +13768,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEK.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PLinVelEK)>0) OutData%PLinVelEK = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PLinVelEK))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PLinVelEK) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PLinVelEK,3), UBOUND(OutData%PLinVelEK,3) + DO i2 = LBOUND(OutData%PLinVelEK,2), UBOUND(OutData%PLinVelEK,2) + DO i1 = LBOUND(OutData%PLinVelEK,1), UBOUND(OutData%PLinVelEK,1) + OutData%PLinVelEK(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelEP not allocated Int_Xferred = Int_Xferred + 1 @@ -13821,15 +13796,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PLinVelEP)>0) OutData%PLinVelEP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PLinVelEP))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PLinVelEP) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PLinVelEP,3), UBOUND(OutData%PLinVelEP,3) + DO i2 = LBOUND(OutData%PLinVelEP,2), UBOUND(OutData%PLinVelEP,2) + DO i1 = LBOUND(OutData%PLinVelEP,1), UBOUND(OutData%PLinVelEP,1) + OutData%PLinVelEP(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelEQ not allocated Int_Xferred = Int_Xferred + 1 @@ -13850,15 +13824,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEQ.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PLinVelEQ)>0) OutData%PLinVelEQ = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PLinVelEQ))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PLinVelEQ) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PLinVelEQ,3), UBOUND(OutData%PLinVelEQ,3) + DO i2 = LBOUND(OutData%PLinVelEQ,2), UBOUND(OutData%PLinVelEQ,2) + DO i1 = LBOUND(OutData%PLinVelEQ,1), UBOUND(OutData%PLinVelEQ,1) + OutData%PLinVelEQ(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelEU not allocated Int_Xferred = Int_Xferred + 1 @@ -13879,15 +13852,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEU.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PLinVelEU)>0) OutData%PLinVelEU = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PLinVelEU))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PLinVelEU) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PLinVelEU,3), UBOUND(OutData%PLinVelEU,3) + DO i2 = LBOUND(OutData%PLinVelEU,2), UBOUND(OutData%PLinVelEU,2) + DO i1 = LBOUND(OutData%PLinVelEU,1), UBOUND(OutData%PLinVelEU,1) + OutData%PLinVelEU(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelEV not allocated Int_Xferred = Int_Xferred + 1 @@ -13908,15 +13880,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEV.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PLinVelEV)>0) OutData%PLinVelEV = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PLinVelEV))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PLinVelEV) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PLinVelEV,3), UBOUND(OutData%PLinVelEV,3) + DO i2 = LBOUND(OutData%PLinVelEV,2), UBOUND(OutData%PLinVelEV,2) + DO i1 = LBOUND(OutData%PLinVelEV,1), UBOUND(OutData%PLinVelEV,1) + OutData%PLinVelEV(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelEW not allocated Int_Xferred = Int_Xferred + 1 @@ -13937,15 +13908,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEW.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PLinVelEW)>0) OutData%PLinVelEW = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PLinVelEW))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PLinVelEW) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PLinVelEW,3), UBOUND(OutData%PLinVelEW,3) + DO i2 = LBOUND(OutData%PLinVelEW,2), UBOUND(OutData%PLinVelEW,2) + DO i1 = LBOUND(OutData%PLinVelEW,1), UBOUND(OutData%PLinVelEW,1) + OutData%PLinVelEW(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PLinVelEY not allocated Int_Xferred = Int_Xferred + 1 @@ -13966,38 +13936,27 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PLinVelEY.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PLinVelEY)>0) OutData%PLinVelEY = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PLinVelEY))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PLinVelEY) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PLinVelEY,3), UBOUND(OutData%PLinVelEY,3) + DO i2 = LBOUND(OutData%PLinVelEY,2), UBOUND(OutData%PLinVelEY,2) + DO i1 = LBOUND(OutData%PLinVelEY,1), UBOUND(OutData%PLinVelEY,1) + OutData%PLinVelEY(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF i1_l = LBOUND(OutData%LinAccEIMUt,1) i1_u = UBOUND(OutData%LinAccEIMUt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%LinAccEIMUt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LinAccEIMUt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LinAccEIMUt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LinAccEIMUt,1), UBOUND(OutData%LinAccEIMUt,1) + OutData%LinAccEIMUt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%LinAccEOt,1) i1_u = UBOUND(OutData%LinAccEOt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%LinAccEOt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LinAccEOt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LinAccEOt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LinAccEOt,1), UBOUND(OutData%LinAccEOt,1) + OutData%LinAccEOt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinAccESt not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -14017,15 +13976,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinAccESt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%LinAccESt)>0) OutData%LinAccESt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LinAccESt))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LinAccESt) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%LinAccESt,3), UBOUND(OutData%LinAccESt,3) + DO i2 = LBOUND(OutData%LinAccESt,2), UBOUND(OutData%LinAccESt,2) + DO i1 = LBOUND(OutData%LinAccESt,1), UBOUND(OutData%LinAccESt,1) + OutData%LinAccESt(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinAccETt not allocated Int_Xferred = Int_Xferred + 1 @@ -14043,82 +14001,49 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinAccETt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%LinAccETt)>0) OutData%LinAccETt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LinAccETt))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LinAccETt) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%LinAccETt,2), UBOUND(OutData%LinAccETt,2) + DO i1 = LBOUND(OutData%LinAccETt,1), UBOUND(OutData%LinAccETt,1) + OutData%LinAccETt(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF i1_l = LBOUND(OutData%LinAccEZt,1) i1_u = UBOUND(OutData%LinAccEZt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%LinAccEZt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LinAccEZt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LinAccEZt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LinAccEZt,1), UBOUND(OutData%LinAccEZt,1) + OutData%LinAccEZt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%LinVelEIMU,1) i1_u = UBOUND(OutData%LinVelEIMU,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%LinVelEIMU = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LinVelEIMU))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LinVelEIMU) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LinVelEIMU,1), UBOUND(OutData%LinVelEIMU,1) + OutData%LinVelEIMU(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%LinVelEZ,1) i1_u = UBOUND(OutData%LinVelEZ,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%LinVelEZ = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LinVelEZ))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LinVelEZ) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LinVelEZ,1), UBOUND(OutData%LinVelEZ,1) + OutData%LinVelEZ(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%LinVelEO,1) i1_u = UBOUND(OutData%LinVelEO,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%LinVelEO = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LinVelEO))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LinVelEO) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LinVelEO,1), UBOUND(OutData%LinVelEO,1) + OutData%LinVelEO(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%FrcONcRtt,1) i1_u = UBOUND(OutData%FrcONcRtt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%FrcONcRtt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FrcONcRtt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FrcONcRtt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FrcONcRtt,1), UBOUND(OutData%FrcONcRtt,1) + OutData%FrcONcRtt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%FrcPRott,1) i1_u = UBOUND(OutData%FrcPRott,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%FrcPRott = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FrcPRott))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FrcPRott) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FrcPRott,1), UBOUND(OutData%FrcPRott,1) + OutData%FrcPRott(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FrcS0Bt not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -14135,27 +14060,19 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FrcS0Bt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%FrcS0Bt)>0) OutData%FrcS0Bt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FrcS0Bt))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FrcS0Bt) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%FrcS0Bt,2), UBOUND(OutData%FrcS0Bt,2) + DO i1 = LBOUND(OutData%FrcS0Bt,1), UBOUND(OutData%FrcS0Bt,1) + OutData%FrcS0Bt(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF i1_l = LBOUND(OutData%FrcT0Trbt,1) i1_u = UBOUND(OutData%FrcT0Trbt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%FrcT0Trbt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FrcT0Trbt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FrcT0Trbt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FrcT0Trbt,1), UBOUND(OutData%FrcT0Trbt,1) + OutData%FrcT0Trbt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FSAero not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -14175,15 +14092,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FSAero.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%FSAero)>0) OutData%FSAero = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FSAero))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FSAero) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%FSAero,3), UBOUND(OutData%FSAero,3) + DO i2 = LBOUND(OutData%FSAero,2), UBOUND(OutData%FSAero,2) + DO i1 = LBOUND(OutData%FSAero,1), UBOUND(OutData%FSAero,1) + OutData%FSAero(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FSTipDrag not allocated Int_Xferred = Int_Xferred + 1 @@ -14201,15 +14117,12 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FSTipDrag.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%FSTipDrag)>0) OutData%FSTipDrag = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FSTipDrag))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FSTipDrag) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%FSTipDrag,2), UBOUND(OutData%FSTipDrag,2) + DO i1 = LBOUND(OutData%FSTipDrag,1), UBOUND(OutData%FSTipDrag,1) + OutData%FSTipDrag(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FTHydrot not allocated Int_Xferred = Int_Xferred + 1 @@ -14227,27 +14140,19 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FTHydrot.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%FTHydrot)>0) OutData%FTHydrot = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FTHydrot))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FTHydrot) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%FTHydrot,2), UBOUND(OutData%FTHydrot,2) + DO i1 = LBOUND(OutData%FTHydrot,1), UBOUND(OutData%FTHydrot,1) + OutData%FTHydrot(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF i1_l = LBOUND(OutData%FZHydrot,1) i1_u = UBOUND(OutData%FZHydrot,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%FZHydrot = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FZHydrot))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FZHydrot) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FZHydrot,1), UBOUND(OutData%FZHydrot,1) + OutData%FZHydrot(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MFHydrot not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -14264,27 +14169,19 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MFHydrot.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%MFHydrot)>0) OutData%MFHydrot = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MFHydrot))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%MFHydrot) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%MFHydrot,2), UBOUND(OutData%MFHydrot,2) + DO i1 = LBOUND(OutData%MFHydrot,1), UBOUND(OutData%MFHydrot,1) + OutData%MFHydrot(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF i1_l = LBOUND(OutData%MomBNcRtt,1) i1_u = UBOUND(OutData%MomBNcRtt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%MomBNcRtt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MomBNcRtt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%MomBNcRtt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%MomBNcRtt,1), UBOUND(OutData%MomBNcRtt,1) + OutData%MomBNcRtt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MomH0Bt not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -14301,60 +14198,37 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MomH0Bt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%MomH0Bt)>0) OutData%MomH0Bt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MomH0Bt))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%MomH0Bt) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%MomH0Bt,2), UBOUND(OutData%MomH0Bt,2) + DO i1 = LBOUND(OutData%MomH0Bt,1), UBOUND(OutData%MomH0Bt,1) + OutData%MomH0Bt(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF i1_l = LBOUND(OutData%MomLPRott,1) i1_u = UBOUND(OutData%MomLPRott,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%MomLPRott = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MomLPRott))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%MomLPRott) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%MomLPRott,1), UBOUND(OutData%MomLPRott,1) + OutData%MomLPRott(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%MomNGnRtt,1) i1_u = UBOUND(OutData%MomNGnRtt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%MomNGnRtt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MomNGnRtt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%MomNGnRtt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%MomNGnRtt,1), UBOUND(OutData%MomNGnRtt,1) + OutData%MomNGnRtt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%MomNTailt,1) i1_u = UBOUND(OutData%MomNTailt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%MomNTailt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MomNTailt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%MomNTailt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%MomNTailt,1), UBOUND(OutData%MomNTailt,1) + OutData%MomNTailt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%MomX0Trbt,1) i1_u = UBOUND(OutData%MomX0Trbt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%MomX0Trbt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MomX0Trbt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%MomX0Trbt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%MomX0Trbt,1), UBOUND(OutData%MomX0Trbt,1) + OutData%MomX0Trbt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MMAero not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -14374,27 +14248,21 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MMAero.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%MMAero)>0) OutData%MMAero = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MMAero))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%MMAero) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%MMAero,3), UBOUND(OutData%MMAero,3) + DO i2 = LBOUND(OutData%MMAero,2), UBOUND(OutData%MMAero,2) + DO i1 = LBOUND(OutData%MMAero,1), UBOUND(OutData%MMAero,1) + OutData%MMAero(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF i1_l = LBOUND(OutData%MXHydrot,1) i1_u = UBOUND(OutData%MXHydrot,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%MXHydrot = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MXHydrot))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%MXHydrot) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%MXHydrot,1), UBOUND(OutData%MXHydrot,1) + OutData%MXHydrot(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PFrcONcRt not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -14411,15 +14279,12 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFrcONcRt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PFrcONcRt)>0) OutData%PFrcONcRt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PFrcONcRt))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PFrcONcRt) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PFrcONcRt,2), UBOUND(OutData%PFrcONcRt,2) + DO i1 = LBOUND(OutData%PFrcONcRt,1), UBOUND(OutData%PFrcONcRt,1) + OutData%PFrcONcRt(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PFrcPRot not allocated Int_Xferred = Int_Xferred + 1 @@ -14437,15 +14302,12 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFrcPRot.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PFrcPRot)>0) OutData%PFrcPRot = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PFrcPRot))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PFrcPRot) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PFrcPRot,2), UBOUND(OutData%PFrcPRot,2) + DO i1 = LBOUND(OutData%PFrcPRot,1), UBOUND(OutData%PFrcPRot,1) + OutData%PFrcPRot(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PFrcS0B not allocated Int_Xferred = Int_Xferred + 1 @@ -14466,15 +14328,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFrcS0B.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PFrcS0B)>0) OutData%PFrcS0B = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PFrcS0B))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PFrcS0B) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PFrcS0B,3), UBOUND(OutData%PFrcS0B,3) + DO i2 = LBOUND(OutData%PFrcS0B,2), UBOUND(OutData%PFrcS0B,2) + DO i1 = LBOUND(OutData%PFrcS0B,1), UBOUND(OutData%PFrcS0B,1) + OutData%PFrcS0B(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PFrcT0Trb not allocated Int_Xferred = Int_Xferred + 1 @@ -14492,15 +14353,12 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFrcT0Trb.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PFrcT0Trb)>0) OutData%PFrcT0Trb = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PFrcT0Trb))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PFrcT0Trb) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PFrcT0Trb,2), UBOUND(OutData%PFrcT0Trb,2) + DO i1 = LBOUND(OutData%PFrcT0Trb,1), UBOUND(OutData%PFrcT0Trb,1) + OutData%PFrcT0Trb(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PFTHydro not allocated Int_Xferred = Int_Xferred + 1 @@ -14521,29 +14379,25 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFTHydro.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PFTHydro)>0) OutData%PFTHydro = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PFTHydro))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PFTHydro) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PFTHydro,3), UBOUND(OutData%PFTHydro,3) + DO i2 = LBOUND(OutData%PFTHydro,2), UBOUND(OutData%PFTHydro,2) + DO i1 = LBOUND(OutData%PFTHydro,1), UBOUND(OutData%PFTHydro,1) + OutData%PFTHydro(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF i1_l = LBOUND(OutData%PFZHydro,1) i1_u = UBOUND(OutData%PFZHydro,1) i2_l = LBOUND(OutData%PFZHydro,2) i2_u = UBOUND(OutData%PFZHydro,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%PFZHydro = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PFZHydro))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PFZHydro) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PFZHydro,2), UBOUND(OutData%PFZHydro,2) + DO i1 = LBOUND(OutData%PFZHydro,1), UBOUND(OutData%PFZHydro,1) + OutData%PFZHydro(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PMFHydro not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -14563,15 +14417,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMFHydro.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PMFHydro)>0) OutData%PMFHydro = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PMFHydro))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PMFHydro) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PMFHydro,3), UBOUND(OutData%PMFHydro,3) + DO i2 = LBOUND(OutData%PMFHydro,2), UBOUND(OutData%PMFHydro,2) + DO i1 = LBOUND(OutData%PMFHydro,1), UBOUND(OutData%PMFHydro,1) + OutData%PMFHydro(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PMomBNcRt not allocated Int_Xferred = Int_Xferred + 1 @@ -14589,15 +14442,12 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMomBNcRt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PMomBNcRt)>0) OutData%PMomBNcRt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PMomBNcRt))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PMomBNcRt) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PMomBNcRt,2), UBOUND(OutData%PMomBNcRt,2) + DO i1 = LBOUND(OutData%PMomBNcRt,1), UBOUND(OutData%PMomBNcRt,1) + OutData%PMomBNcRt(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PMomH0B not allocated Int_Xferred = Int_Xferred + 1 @@ -14618,15 +14468,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMomH0B.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PMomH0B)>0) OutData%PMomH0B = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PMomH0B))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PMomH0B) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PMomH0B,3), UBOUND(OutData%PMomH0B,3) + DO i2 = LBOUND(OutData%PMomH0B,2), UBOUND(OutData%PMomH0B,2) + DO i1 = LBOUND(OutData%PMomH0B,1), UBOUND(OutData%PMomH0B,1) + OutData%PMomH0B(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PMomLPRot not allocated Int_Xferred = Int_Xferred + 1 @@ -14644,15 +14493,12 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMomLPRot.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PMomLPRot)>0) OutData%PMomLPRot = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PMomLPRot))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PMomLPRot) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PMomLPRot,2), UBOUND(OutData%PMomLPRot,2) + DO i1 = LBOUND(OutData%PMomLPRot,1), UBOUND(OutData%PMomLPRot,1) + OutData%PMomLPRot(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PMomNGnRt not allocated Int_Xferred = Int_Xferred + 1 @@ -14670,15 +14516,12 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMomNGnRt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PMomNGnRt)>0) OutData%PMomNGnRt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PMomNGnRt))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PMomNGnRt) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PMomNGnRt,2), UBOUND(OutData%PMomNGnRt,2) + DO i1 = LBOUND(OutData%PMomNGnRt,1), UBOUND(OutData%PMomNGnRt,1) + OutData%PMomNGnRt(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PMomNTail not allocated Int_Xferred = Int_Xferred + 1 @@ -14696,15 +14539,12 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMomNTail.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PMomNTail)>0) OutData%PMomNTail = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PMomNTail))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PMomNTail) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PMomNTail,2), UBOUND(OutData%PMomNTail,2) + DO i1 = LBOUND(OutData%PMomNTail,1), UBOUND(OutData%PMomNTail,1) + OutData%PMomNTail(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PMomX0Trb not allocated Int_Xferred = Int_Xferred + 1 @@ -14722,75 +14562,49 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMomX0Trb.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PMomX0Trb)>0) OutData%PMomX0Trb = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PMomX0Trb))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PMomX0Trb) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PMomX0Trb,2), UBOUND(OutData%PMomX0Trb,2) + DO i1 = LBOUND(OutData%PMomX0Trb,1), UBOUND(OutData%PMomX0Trb,1) + OutData%PMomX0Trb(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF i1_l = LBOUND(OutData%PMXHydro,1) i1_u = UBOUND(OutData%PMXHydro,1) i2_l = LBOUND(OutData%PMXHydro,2) i2_u = UBOUND(OutData%PMXHydro,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%PMXHydro = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PMXHydro))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PMXHydro) - DEALLOCATE(mask2) - OutData%TeetAng = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 + DO i2 = LBOUND(OutData%PMXHydro,2), UBOUND(OutData%PMXHydro,2) + DO i1 = LBOUND(OutData%PMXHydro,1), UBOUND(OutData%PMXHydro,1) + OutData%PMXHydro(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + OutData%TeetAng = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 i1_l = LBOUND(OutData%FrcVGnRtt,1) i1_u = UBOUND(OutData%FrcVGnRtt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%FrcVGnRtt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FrcVGnRtt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FrcVGnRtt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FrcVGnRtt,1), UBOUND(OutData%FrcVGnRtt,1) + OutData%FrcVGnRtt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%FrcWTailt,1) i1_u = UBOUND(OutData%FrcWTailt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%FrcWTailt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FrcWTailt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FrcWTailt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FrcWTailt,1), UBOUND(OutData%FrcWTailt,1) + OutData%FrcWTailt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%FrcZAllt,1) i1_u = UBOUND(OutData%FrcZAllt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%FrcZAllt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FrcZAllt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FrcZAllt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FrcZAllt,1), UBOUND(OutData%FrcZAllt,1) + OutData%FrcZAllt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%MomXAllt,1) i1_u = UBOUND(OutData%MomXAllt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%MomXAllt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MomXAllt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%MomXAllt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%MomXAllt,1), UBOUND(OutData%MomXAllt,1) + OutData%MomXAllt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PFrcVGnRt not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -14807,15 +14621,12 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFrcVGnRt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PFrcVGnRt)>0) OutData%PFrcVGnRt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PFrcVGnRt))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PFrcVGnRt) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PFrcVGnRt,2), UBOUND(OutData%PFrcVGnRt,2) + DO i1 = LBOUND(OutData%PFrcVGnRt,1), UBOUND(OutData%PFrcVGnRt,1) + OutData%PFrcVGnRt(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PFrcWTail not allocated Int_Xferred = Int_Xferred + 1 @@ -14833,15 +14644,12 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFrcWTail.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PFrcWTail)>0) OutData%PFrcWTail = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PFrcWTail))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PFrcWTail) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PFrcWTail,2), UBOUND(OutData%PFrcWTail,2) + DO i1 = LBOUND(OutData%PFrcWTail,1), UBOUND(OutData%PFrcWTail,1) + OutData%PFrcWTail(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PFrcZAll not allocated Int_Xferred = Int_Xferred + 1 @@ -14859,15 +14667,12 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PFrcZAll.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PFrcZAll)>0) OutData%PFrcZAll = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PFrcZAll))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PFrcZAll) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PFrcZAll,2), UBOUND(OutData%PFrcZAll,2) + DO i1 = LBOUND(OutData%PFrcZAll,1), UBOUND(OutData%PFrcZAll,1) + OutData%PFrcZAll(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PMomXAll not allocated Int_Xferred = Int_Xferred + 1 @@ -14885,24 +14690,21 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PMomXAll.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PMomXAll)>0) OutData%PMomXAll = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PMomXAll))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PMomXAll) - DEALLOCATE(mask2) - END IF - OutData%TeetMom = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlMom = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlMom = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GBoxEffFac = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(OutData%PMomXAll,2), UBOUND(OutData%PMomXAll,2) + DO i1 = LBOUND(OutData%PMomXAll,1), UBOUND(OutData%PMomXAll,1) + OutData%PMomXAll(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%TeetMom = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlMom = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlMom = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GBoxEffFac = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rSAerCen not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -14922,15 +14724,14 @@ SUBROUTINE ED_UnPackRtHndSide( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rSAerCen.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%rSAerCen)>0) OutData%rSAerCen = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%rSAerCen))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%rSAerCen) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%rSAerCen,3), UBOUND(OutData%rSAerCen,3) + DO i2 = LBOUND(OutData%rSAerCen,2), UBOUND(OutData%rSAerCen,2) + DO i1 = LBOUND(OutData%rSAerCen,1), UBOUND(OutData%rSAerCen,1) + OutData%rSAerCen(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF END SUBROUTINE ED_UnPackRtHndSide @@ -15074,8 +14875,10 @@ SUBROUTINE ED_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QT,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%QT)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%QT))-1 ) = PACK(InData%QT,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%QT) + DO i1 = LBOUND(InData%QT,1), UBOUND(InData%QT,1) + DbKiBuf(Db_Xferred) = InData%QT(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%QDT) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -15087,8 +14890,10 @@ SUBROUTINE ED_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QDT,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%QDT)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%QDT))-1 ) = PACK(InData%QDT,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%QDT) + DO i1 = LBOUND(InData%QDT,1), UBOUND(InData%QDT,1) + DbKiBuf(Db_Xferred) = InData%QDT(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF END SUBROUTINE ED_PackContState @@ -15105,12 +14910,6 @@ SUBROUTINE ED_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -15138,15 +14937,10 @@ SUBROUTINE ED_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%QT.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%QT)>0) OutData%QT = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%QT))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%QT) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%QT,1), UBOUND(OutData%QT,1) + OutData%QT(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QDT not allocated Int_Xferred = Int_Xferred + 1 @@ -15161,15 +14955,10 @@ SUBROUTINE ED_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%QDT.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%QDT)>0) OutData%QDT = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%QDT))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%QDT) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%QDT,1), UBOUND(OutData%QDT,1) + OutData%QDT(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO END IF END SUBROUTINE ED_UnPackContState @@ -15264,8 +15053,8 @@ SUBROUTINE ED_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyDiscState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyDiscState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE ED_PackDiscState SUBROUTINE ED_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -15281,12 +15070,6 @@ SUBROUTINE ED_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ED_UnPackDiscState' @@ -15300,8 +15083,8 @@ SUBROUTINE ED_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyDiscState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyDiscState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE ED_UnPackDiscState SUBROUTINE ED_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) @@ -15395,8 +15178,8 @@ SUBROUTINE ED_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyConstrState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE ED_PackConstrState SUBROUTINE ED_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -15412,12 +15195,6 @@ SUBROUTINE ED_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ED_UnPackConstrState' @@ -15431,8 +15208,8 @@ SUBROUTINE ED_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyConstrState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyConstrState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE ED_UnPackConstrState SUBROUTINE ED_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -15583,8 +15360,8 @@ SUBROUTINE ED_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%n - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%n + Int_Xferred = Int_Xferred + 1 DO i1 = LBOUND(InData%xdot,1), UBOUND(InData%xdot,1) CALL ED_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xdot(i1), ErrStat2, ErrMsg2, OnlySize ) ! xdot CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -15625,17 +15402,21 @@ SUBROUTINE ED_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IC,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%IC)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%IC))-1 ) = PACK(InData%IC,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%IC) + DO i1 = LBOUND(InData%IC,1), UBOUND(InData%IC,1) + IntKiBuf(Int_Xferred) = InData%IC(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HSSBrTrq - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HSSBrTrqC - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%SgnPrvLSTQ - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%SgnLSTQ))-1 ) = PACK(InData%SgnLSTQ,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%SgnLSTQ) + ReKiBuf(Re_Xferred) = InData%HSSBrTrq + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HSSBrTrqC + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%SgnPrvLSTQ + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%SgnLSTQ,1), UBOUND(InData%SgnLSTQ,1) + IntKiBuf(Int_Xferred) = InData%SgnLSTQ(i1) + Int_Xferred = Int_Xferred + 1 + END DO END SUBROUTINE ED_PackOtherState SUBROUTINE ED_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -15651,12 +15432,6 @@ SUBROUTINE ED_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -15671,8 +15446,8 @@ SUBROUTINE ED_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%n = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%n = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%xdot,1) i1_u = UBOUND(OutData%xdot,1) DO i1 = LBOUND(OutData%xdot,1), UBOUND(OutData%xdot,1) @@ -15730,33 +15505,23 @@ SUBROUTINE ED_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IC.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%IC)>0) OutData%IC = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%IC))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%IC) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%IC,1), UBOUND(OutData%IC,1) + OutData%IC(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF - OutData%HSSBrTrq = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HSSBrTrqC = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SgnPrvLSTQ = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%HSSBrTrq = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HSSBrTrqC = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SgnPrvLSTQ = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%SgnLSTQ,1) i1_u = UBOUND(OutData%SgnLSTQ,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%SgnLSTQ = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%SgnLSTQ))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%SgnLSTQ) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%SgnLSTQ,1), UBOUND(OutData%SgnLSTQ,1) + OutData%SgnLSTQ(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END SUBROUTINE ED_UnPackOtherState SUBROUTINE ED_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) @@ -16105,8 +15870,10 @@ SUBROUTINE ED_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AllOuts,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AllOuts)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AllOuts))-1 ) = PACK(InData%AllOuts,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AllOuts) + DO i1 = LBOUND(InData%AllOuts,1), UBOUND(InData%AllOuts,1) + ReKiBuf(Re_Xferred) = InData%AllOuts(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%AugMat) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -16121,8 +15888,12 @@ SUBROUTINE ED_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AugMat,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AugMat)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%AugMat))-1 ) = PACK(InData%AugMat,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%AugMat) + DO i2 = LBOUND(InData%AugMat,2), UBOUND(InData%AugMat,2) + DO i1 = LBOUND(InData%AugMat,1), UBOUND(InData%AugMat,1) + DbKiBuf(Db_Xferred) = InData%AugMat(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%AugMat_factor) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -16137,8 +15908,12 @@ SUBROUTINE ED_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AugMat_factor,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AugMat_factor)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%AugMat_factor))-1 ) = PACK(InData%AugMat_factor,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%AugMat_factor) + DO i2 = LBOUND(InData%AugMat_factor,2), UBOUND(InData%AugMat_factor,2) + DO i1 = LBOUND(InData%AugMat_factor,1), UBOUND(InData%AugMat_factor,1) + DbKiBuf(Db_Xferred) = InData%AugMat_factor(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%SolnVec) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -16150,8 +15925,10 @@ SUBROUTINE ED_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SolnVec,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%SolnVec)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%SolnVec))-1 ) = PACK(InData%SolnVec,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%SolnVec) + DO i1 = LBOUND(InData%SolnVec,1), UBOUND(InData%SolnVec,1) + DbKiBuf(Db_Xferred) = InData%SolnVec(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%AugMat_pivot) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -16163,8 +15940,10 @@ SUBROUTINE ED_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AugMat_pivot,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AugMat_pivot)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%AugMat_pivot))-1 ) = PACK(InData%AugMat_pivot,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%AugMat_pivot) + DO i1 = LBOUND(InData%AugMat_pivot,1), UBOUND(InData%AugMat_pivot,1) + IntKiBuf(Int_Xferred) = InData%AugMat_pivot(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%OgnlGeAzRo) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -16176,8 +15955,10 @@ SUBROUTINE ED_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OgnlGeAzRo,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%OgnlGeAzRo)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%OgnlGeAzRo))-1 ) = PACK(InData%OgnlGeAzRo,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%OgnlGeAzRo) + DO i1 = LBOUND(InData%OgnlGeAzRo,1), UBOUND(InData%OgnlGeAzRo,1) + ReKiBuf(Re_Xferred) = InData%OgnlGeAzRo(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%QD2T) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -16189,11 +15970,13 @@ SUBROUTINE ED_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%QD2T,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%QD2T)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%QD2T))-1 ) = PACK(InData%QD2T,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%QD2T) + DO i1 = LBOUND(InData%QD2T,1), UBOUND(InData%QD2T,1) + DbKiBuf(Db_Xferred) = InData%QD2T(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%IgnoreMod , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%IgnoreMod, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE ED_PackMisc SUBROUTINE ED_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -16209,12 +15992,6 @@ SUBROUTINE ED_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -16323,15 +16100,10 @@ SUBROUTINE ED_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOuts.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%AllOuts)>0) OutData%AllOuts = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AllOuts))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AllOuts) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AllOuts,1), UBOUND(OutData%AllOuts,1) + OutData%AllOuts(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AugMat not allocated Int_Xferred = Int_Xferred + 1 @@ -16349,15 +16121,12 @@ SUBROUTINE ED_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AugMat.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%AugMat)>0) OutData%AugMat = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%AugMat))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%AugMat) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AugMat,2), UBOUND(OutData%AugMat,2) + DO i1 = LBOUND(OutData%AugMat,1), UBOUND(OutData%AugMat,1) + OutData%AugMat(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AugMat_factor not allocated Int_Xferred = Int_Xferred + 1 @@ -16375,15 +16144,12 @@ SUBROUTINE ED_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AugMat_factor.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%AugMat_factor)>0) OutData%AugMat_factor = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%AugMat_factor))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%AugMat_factor) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AugMat_factor,2), UBOUND(OutData%AugMat_factor,2) + DO i1 = LBOUND(OutData%AugMat_factor,1), UBOUND(OutData%AugMat_factor,1) + OutData%AugMat_factor(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SolnVec not allocated Int_Xferred = Int_Xferred + 1 @@ -16398,15 +16164,10 @@ SUBROUTINE ED_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SolnVec.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%SolnVec)>0) OutData%SolnVec = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%SolnVec))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%SolnVec) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%SolnVec,1), UBOUND(OutData%SolnVec,1) + OutData%SolnVec(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AugMat_pivot not allocated Int_Xferred = Int_Xferred + 1 @@ -16421,15 +16182,10 @@ SUBROUTINE ED_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AugMat_pivot.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%AugMat_pivot)>0) OutData%AugMat_pivot = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%AugMat_pivot))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%AugMat_pivot) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AugMat_pivot,1), UBOUND(OutData%AugMat_pivot,1) + OutData%AugMat_pivot(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OgnlGeAzRo not allocated Int_Xferred = Int_Xferred + 1 @@ -16444,15 +16200,10 @@ SUBROUTINE ED_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OgnlGeAzRo.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%OgnlGeAzRo)>0) OutData%OgnlGeAzRo = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%OgnlGeAzRo))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%OgnlGeAzRo) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%OgnlGeAzRo,1), UBOUND(OutData%OgnlGeAzRo,1) + OutData%OgnlGeAzRo(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! QD2T not allocated Int_Xferred = Int_Xferred + 1 @@ -16467,18 +16218,13 @@ SUBROUTINE ED_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%QD2T.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%QD2T)>0) OutData%QD2T = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%QD2T))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%QD2T) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%QD2T,1), UBOUND(OutData%QD2T,1) + OutData%QD2T(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO END IF - OutData%IgnoreMod = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%IgnoreMod = TRANSFER(IntKiBuf(Int_Xferred), OutData%IgnoreMod) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE ED_UnPackMisc SUBROUTINE ED_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -17638,6 +17384,25 @@ SUBROUTINE ED_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) DstParamData%PtfmCMyt = SrcParamData%PtfmCMyt DstParamData%BD4Blades = SrcParamData%BD4Blades DstParamData%UseAD14 = SrcParamData%UseAD14 + DstParamData%BldNd_NumOuts = SrcParamData%BldNd_NumOuts + DstParamData%BldNd_TotNumOuts = SrcParamData%BldNd_TotNumOuts +IF (ALLOCATED(SrcParamData%BldNd_OutParam)) THEN + i1_l = LBOUND(SrcParamData%BldNd_OutParam,1) + i1_u = UBOUND(SrcParamData%BldNd_OutParam,1) + IF (.NOT. ALLOCATED(DstParamData%BldNd_OutParam)) THEN + ALLOCATE(DstParamData%BldNd_OutParam(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%BldNd_OutParam.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcParamData%BldNd_OutParam,1), UBOUND(SrcParamData%BldNd_OutParam,1) + CALL NWTC_Library_Copyoutparmtype( SrcParamData%BldNd_OutParam(i1), DstParamData%BldNd_OutParam(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF + DstParamData%BldNd_BladesOut = SrcParamData%BldNd_BladesOut IF (ALLOCATED(SrcParamData%Jac_u_indx)) THEN i1_l = LBOUND(SrcParamData%Jac_u_indx,1) i1_u = UBOUND(SrcParamData%Jac_u_indx,1) @@ -17905,6 +17670,12 @@ SUBROUTINE ED_DestroyParam( ParamData, ErrStat, ErrMsg ) IF (ALLOCATED(ParamData%TElmntMass)) THEN DEALLOCATE(ParamData%TElmntMass) ENDIF +IF (ALLOCATED(ParamData%BldNd_OutParam)) THEN +DO i1 = LBOUND(ParamData%BldNd_OutParam,1), UBOUND(ParamData%BldNd_OutParam,1) + CALL NWTC_Library_Destroyoutparmtype( ParamData%BldNd_OutParam(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(ParamData%BldNd_OutParam) +ENDIF IF (ALLOCATED(ParamData%Jac_u_indx)) THEN DEALLOCATE(ParamData%Jac_u_indx) ENDIF @@ -18511,6 +18282,32 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Re_BufSz = Re_BufSz + 1 ! PtfmCMyt Int_BufSz = Int_BufSz + 1 ! BD4Blades Int_BufSz = Int_BufSz + 1 ! UseAD14 + Int_BufSz = Int_BufSz + 1 ! BldNd_NumOuts + Int_BufSz = Int_BufSz + 1 ! BldNd_TotNumOuts + Int_BufSz = Int_BufSz + 1 ! BldNd_OutParam allocated yes/no + IF ( ALLOCATED(InData%BldNd_OutParam) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! BldNd_OutParam upper/lower bounds for each dimension + DO i1 = LBOUND(InData%BldNd_OutParam,1), UBOUND(InData%BldNd_OutParam,1) + Int_BufSz = Int_BufSz + 3 ! BldNd_OutParam: size of buffers for each call to pack subtype + CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%BldNd_OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BldNd_OutParam + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! BldNd_OutParam + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! BldNd_OutParam + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! BldNd_OutParam + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! BldNd_BladesOut Int_BufSz = Int_BufSz + 1 ! Jac_u_indx allocated yes/no IF ( ALLOCATED(InData%Jac_u_indx) ) THEN Int_BufSz = Int_BufSz + 2*2 ! Jac_u_indx upper/lower bounds for each dimension @@ -18554,22 +18351,22 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT24 - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%BldNodes - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TipNode - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NDOF - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%TwoPiNB - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NAug - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NPH - Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT24 + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%BldNodes + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TipNode + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NDOF + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%TwoPiNB + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NAug + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NPH + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%PH) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -18580,11 +18377,13 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PH,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PH)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%PH))-1 ) = PACK(InData%PH,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%PH) + DO i1 = LBOUND(InData%PH,1), UBOUND(InData%PH,1) + IntKiBuf(Int_Xferred) = InData%PH(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NPM - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NPM + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%PM) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -18598,8 +18397,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PM,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PM)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%PM))-1 ) = PACK(InData%PM,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%PM) + DO i2 = LBOUND(InData%PM,2), UBOUND(InData%PM,2) + DO i1 = LBOUND(InData%PM,1), UBOUND(InData%PM,1) + IntKiBuf(Int_Xferred) = InData%PM(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%DOF_Flag) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -18611,8 +18414,10 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DOF_Flag,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DOF_Flag)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%DOF_Flag)-1 ) = TRANSFER(PACK( InData%DOF_Flag ,.TRUE.), IntKiBuf(1), SIZE(InData%DOF_Flag)) - Int_Xferred = Int_Xferred + SIZE(InData%DOF_Flag) + DO i1 = LBOUND(InData%DOF_Flag,1), UBOUND(InData%DOF_Flag,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%DOF_Flag(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%DOF_Desc) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -18624,12 +18429,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DOF_Desc,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%DOF_Desc,1), UBOUND(InData%DOF_Desc,1) + DO i1 = LBOUND(InData%DOF_Desc,1), UBOUND(InData%DOF_Desc,1) DO I = 1, LEN(InData%DOF_Desc) IntKiBuf(Int_Xferred) = ICHAR(InData%DOF_Desc(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF CALL ED_Packactivedofs( Re_Buf, Db_Buf, Int_Buf, InData%DOFs, ErrStat2, ErrMsg2, OnlySize ) ! DOFs CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -18659,16 +18464,16 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NBlGages - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NTwGages - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%OutFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%NBlGages + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NTwGages + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%OutParam) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -18710,16 +18515,16 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si ENDIF END DO END IF - DO I = 1, LEN(InData%Delim) - IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AvgNrmTpRd - Re_Xferred = Re_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%AzimB1Up - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%CosDel3 - Db_Xferred = Db_Xferred + 1 + DO I = 1, LEN(InData%Delim) + IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + ReKiBuf(Re_Xferred) = InData%AvgNrmTpRd + Re_Xferred = Re_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%AzimB1Up + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%CosDel3 + Db_Xferred = Db_Xferred + 1 IF ( .NOT. ALLOCATED(InData%CosPreC) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -18730,111 +18535,113 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CosPreC,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CosPreC)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%CosPreC))-1 ) = PACK(InData%CosPreC,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%CosPreC) - END IF - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%CRFrlSkew - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%CRFrlSkw2 - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%CRFrlTilt - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%CRFrlTlt2 - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%CShftSkew - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%CShftTilt - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%CSRFrlSkw - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%CSRFrlTlt - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%CSTFrlSkw - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%CSTFrlTlt - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%CTFinBank - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%CTFinSkew - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%CTFinTilt - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%CTFrlSkew - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%CTFrlSkw2 - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%CTFrlTilt - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%CTFrlTlt2 - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HubHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HubCM - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HubRad - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NacCMxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NacCMyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NacCMzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%OverHang - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ProjArea - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmRefzt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RefTwrHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlPntxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlPntyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlPntzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rVDxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rVDyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rVDzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rVIMUxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rVIMUyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rVIMUzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rVPxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rVPyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rVPzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rWIxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rWIyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rWIzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rWJxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rWJyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rWJzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rWKxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rWKyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rWKzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rZT0zt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rZYzt - Re_Xferred = Re_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%SinDel3 - Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(InData%CosPreC,1), UBOUND(InData%CosPreC,1) + DbKiBuf(Db_Xferred) = InData%CosPreC(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + DbKiBuf(Db_Xferred) = InData%CRFrlSkew + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%CRFrlSkw2 + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%CRFrlTilt + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%CRFrlTlt2 + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%CShftSkew + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%CShftTilt + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%CSRFrlSkw + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%CSRFrlTlt + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%CSTFrlSkw + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%CSTFrlTlt + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%CTFinBank + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%CTFinSkew + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%CTFinTilt + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%CTFrlSkew + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%CTFrlSkw2 + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%CTFrlTilt + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%CTFrlTlt2 + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HubHt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HubCM + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HubRad + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NacCMxn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NacCMyn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NacCMzn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%OverHang + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%ProjArea + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmRefzt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RefTwrHt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlPntxn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlPntyn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlPntzn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rVDxn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rVDyn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rVDzn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rVIMUxn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rVIMUyn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rVIMUzn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rVPxn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rVPyn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rVPzn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rWIxn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rWIyn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rWIzn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rWJxn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rWJyn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rWJzn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rWKxn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rWKyn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rWKzn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rZT0zt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rZYzt + Re_Xferred = Re_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%SinDel3 + Db_Xferred = Db_Xferred + 1 IF ( .NOT. ALLOCATED(InData%SinPreC) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -18845,51 +18652,53 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SinPreC,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%SinPreC)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%SinPreC))-1 ) = PACK(InData%SinPreC,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%SinPreC) - END IF - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%SRFrlSkew - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%SRFrlSkw2 - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%SRFrlTilt - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%SRFrlTlt2 - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%SShftSkew - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%SShftTilt - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%STFinBank - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%STFinSkew - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%STFinTilt - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%STFrlSkew - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%STFrlSkw2 - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%STFrlTilt - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%STFrlTlt2 - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlPntxn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlPntyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlPntzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TipRad - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TowerHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TowerBsHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%UndSling - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumBl - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%SinPreC,1), UBOUND(InData%SinPreC,1) + DbKiBuf(Db_Xferred) = InData%SinPreC(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + DbKiBuf(Db_Xferred) = InData%SRFrlSkew + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%SRFrlSkw2 + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%SRFrlTilt + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%SRFrlTlt2 + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%SShftSkew + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%SShftTilt + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%STFinBank + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%STFinSkew + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%STFinTilt + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%STFrlSkew + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%STFrlSkw2 + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%STFrlTilt + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%STFrlTlt2 + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlPntxn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlPntyn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlPntzn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TipRad + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TowerHt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TowerBsHt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%UndSling + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumBl + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%AxRedTFA) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -18906,8 +18715,14 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxRedTFA,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AxRedTFA)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AxRedTFA))-1 ) = PACK(InData%AxRedTFA,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AxRedTFA) + DO i3 = LBOUND(InData%AxRedTFA,3), UBOUND(InData%AxRedTFA,3) + DO i2 = LBOUND(InData%AxRedTFA,2), UBOUND(InData%AxRedTFA,2) + DO i1 = LBOUND(InData%AxRedTFA,1), UBOUND(InData%AxRedTFA,1) + ReKiBuf(Re_Xferred) = InData%AxRedTFA(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%AxRedTSS) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -18925,13 +18740,27 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxRedTSS,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AxRedTSS)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AxRedTSS))-1 ) = PACK(InData%AxRedTSS,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AxRedTSS) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CTFA))-1 ) = PACK(InData%CTFA,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CTFA) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CTSS))-1 ) = PACK(InData%CTSS,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CTSS) + DO i3 = LBOUND(InData%AxRedTSS,3), UBOUND(InData%AxRedTSS,3) + DO i2 = LBOUND(InData%AxRedTSS,2), UBOUND(InData%AxRedTSS,2) + DO i1 = LBOUND(InData%AxRedTSS,1), UBOUND(InData%AxRedTSS,1) + ReKiBuf(Re_Xferred) = InData%AxRedTSS(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + DO i2 = LBOUND(InData%CTFA,2), UBOUND(InData%CTFA,2) + DO i1 = LBOUND(InData%CTFA,1), UBOUND(InData%CTFA,1) + ReKiBuf(Re_Xferred) = InData%CTFA(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%CTSS,2), UBOUND(InData%CTSS,2) + DO i1 = LBOUND(InData%CTSS,1), UBOUND(InData%CTSS,1) + ReKiBuf(Re_Xferred) = InData%CTSS(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO IF ( .NOT. ALLOCATED(InData%DHNodes) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -18942,8 +18771,10 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DHNodes,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DHNodes)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%DHNodes))-1 ) = PACK(InData%DHNodes,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%DHNodes) + DO i1 = LBOUND(InData%DHNodes,1), UBOUND(InData%DHNodes,1) + ReKiBuf(Re_Xferred) = InData%DHNodes(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%HNodes) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -18955,8 +18786,10 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HNodes,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%HNodes)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%HNodes))-1 ) = PACK(InData%HNodes,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%HNodes) + DO i1 = LBOUND(InData%HNodes,1), UBOUND(InData%HNodes,1) + ReKiBuf(Re_Xferred) = InData%HNodes(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%HNodesNorm) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -18968,13 +18801,23 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HNodesNorm,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%HNodesNorm)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%HNodesNorm))-1 ) = PACK(InData%HNodesNorm,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%HNodesNorm) + DO i1 = LBOUND(InData%HNodesNorm,1), UBOUND(InData%HNodesNorm,1) + ReKiBuf(Re_Xferred) = InData%HNodesNorm(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%KTFA))-1 ) = PACK(InData%KTFA,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%KTFA) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%KTSS))-1 ) = PACK(InData%KTSS,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%KTSS) + DO i2 = LBOUND(InData%KTFA,2), UBOUND(InData%KTFA,2) + DO i1 = LBOUND(InData%KTFA,1), UBOUND(InData%KTFA,1) + ReKiBuf(Re_Xferred) = InData%KTFA(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%KTSS,2), UBOUND(InData%KTSS,2) + DO i1 = LBOUND(InData%KTSS,1), UBOUND(InData%KTSS,1) + ReKiBuf(Re_Xferred) = InData%KTSS(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO IF ( .NOT. ALLOCATED(InData%MassT) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -18985,8 +18828,10 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MassT,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%MassT)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MassT))-1 ) = PACK(InData%MassT,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MassT) + DO i1 = LBOUND(InData%MassT,1), UBOUND(InData%MassT,1) + ReKiBuf(Re_Xferred) = InData%MassT(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%StiffTSS) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -18998,8 +18843,10 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StiffTSS,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%StiffTSS)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%StiffTSS))-1 ) = PACK(InData%StiffTSS,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%StiffTSS) + DO i1 = LBOUND(InData%StiffTSS,1), UBOUND(InData%StiffTSS,1) + ReKiBuf(Re_Xferred) = InData%StiffTSS(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TwrFASF) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19017,11 +18864,17 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrFASF,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwrFASF)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwrFASF))-1 ) = PACK(InData%TwrFASF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwrFASF) + DO i3 = LBOUND(InData%TwrFASF,3), UBOUND(InData%TwrFASF,3) + DO i2 = LBOUND(InData%TwrFASF,2), UBOUND(InData%TwrFASF,2) + DO i1 = LBOUND(InData%TwrFASF,1), UBOUND(InData%TwrFASF,1) + ReKiBuf(Re_Xferred) = InData%TwrFASF(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TwrFlexL - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TwrFlexL + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%TwrSSSF) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -19038,13 +18891,19 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrSSSF,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwrSSSF)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwrSSSF))-1 ) = PACK(InData%TwrSSSF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwrSSSF) + DO i3 = LBOUND(InData%TwrSSSF,3), UBOUND(InData%TwrSSSF,3) + DO i2 = LBOUND(InData%TwrSSSF,2), UBOUND(InData%TwrSSSF,2) + DO i1 = LBOUND(InData%TwrSSSF,1), UBOUND(InData%TwrSSSF,1) + ReKiBuf(Re_Xferred) = InData%TwrSSSF(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TTopNode - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TwrNodes - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TTopNode + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TwrNodes + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%InerTFA) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -19055,8 +18914,10 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InerTFA,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%InerTFA)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%InerTFA))-1 ) = PACK(InData%InerTFA,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%InerTFA) + DO i1 = LBOUND(InData%InerTFA,1), UBOUND(InData%InerTFA,1) + ReKiBuf(Re_Xferred) = InData%InerTFA(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%InerTSS) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19068,8 +18929,10 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InerTSS,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%InerTSS)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%InerTSS))-1 ) = PACK(InData%InerTSS,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%InerTSS) + DO i1 = LBOUND(InData%InerTSS,1), UBOUND(InData%InerTSS,1) + ReKiBuf(Re_Xferred) = InData%InerTSS(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%StiffTGJ) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19081,8 +18944,10 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StiffTGJ,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%StiffTGJ)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%StiffTGJ))-1 ) = PACK(InData%StiffTGJ,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%StiffTGJ) + DO i1 = LBOUND(InData%StiffTGJ,1), UBOUND(InData%StiffTGJ,1) + ReKiBuf(Re_Xferred) = InData%StiffTGJ(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%StiffTEA) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19094,8 +18959,10 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StiffTEA,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%StiffTEA)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%StiffTEA))-1 ) = PACK(InData%StiffTEA,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%StiffTEA) + DO i1 = LBOUND(InData%StiffTEA,1), UBOUND(InData%StiffTEA,1) + ReKiBuf(Re_Xferred) = InData%StiffTEA(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%StiffTFA) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19107,8 +18974,10 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StiffTFA,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%StiffTFA)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%StiffTFA))-1 ) = PACK(InData%StiffTFA,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%StiffTFA) + DO i1 = LBOUND(InData%StiffTFA,1), UBOUND(InData%StiffTFA,1) + ReKiBuf(Re_Xferred) = InData%StiffTFA(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%cgOffTFA) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19120,8 +18989,10 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%cgOffTFA,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%cgOffTFA)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%cgOffTFA))-1 ) = PACK(InData%cgOffTFA,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%cgOffTFA) + DO i1 = LBOUND(InData%cgOffTFA,1), UBOUND(InData%cgOffTFA,1) + ReKiBuf(Re_Xferred) = InData%cgOffTFA(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%cgOffTSS) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19133,11 +19004,13 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%cgOffTSS,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%cgOffTSS)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%cgOffTSS))-1 ) = PACK(InData%cgOffTSS,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%cgOffTSS) + DO i1 = LBOUND(InData%cgOffTSS,1), UBOUND(InData%cgOffTSS,1) + ReKiBuf(Re_Xferred) = InData%cgOffTSS(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AtfaIner - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AtfaIner + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%BldCG) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -19148,8 +19021,10 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldCG,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BldCG)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BldCG))-1 ) = PACK(InData%BldCG,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BldCG) + DO i1 = LBOUND(InData%BldCG,1), UBOUND(InData%BldCG,1) + ReKiBuf(Re_Xferred) = InData%BldCG(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%BldMass) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19161,11 +19036,13 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldMass,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BldMass)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BldMass))-1 ) = PACK(InData%BldMass,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BldMass) + DO i1 = LBOUND(InData%BldMass,1), UBOUND(InData%BldMass,1) + ReKiBuf(Re_Xferred) = InData%BldMass(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%BoomMass - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%BoomMass + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%FirstMom) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -19176,37 +19053,39 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FirstMom,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FirstMom)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FirstMom))-1 ) = PACK(InData%FirstMom,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FirstMom) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GenIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Hubg1Iner - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Hubg2Iner - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HubMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Nacd2Iner - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NacMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmPIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmRIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmYIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RotIner - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RotMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RrfaIner - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%FirstMom,1), UBOUND(InData%FirstMom,1) + ReKiBuf(Re_Xferred) = InData%FirstMom(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%GenIner + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Hubg1Iner + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Hubg2Iner + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HubMass + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Nacd2Iner + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NacMass + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmMass + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmPIner + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmRIner + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmYIner + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlMass + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RotIner + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RotMass + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RrfaIner + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%SecondMom) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -19217,13 +19096,15 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SecondMom,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%SecondMom)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SecondMom))-1 ) = PACK(InData%SecondMom,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SecondMom) + DO i1 = LBOUND(InData%SecondMom,1), UBOUND(InData%SecondMom,1) + ReKiBuf(Re_Xferred) = InData%SecondMom(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFinMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlIner - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFinMass + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlIner + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%TipMass) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -19234,19 +19115,21 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TipMass,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TipMass)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TipMass))-1 ) = PACK(InData%TipMass,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TipMass) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TurbMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TwrMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TwrTpMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawBrMass - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Gravity - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%TipMass,1), UBOUND(InData%TipMass,1) + ReKiBuf(Re_Xferred) = InData%TipMass(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%TurbMass + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TwrMass + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TwrTpMass + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawBrMass + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Gravity + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%PitchAxis) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -19260,8 +19143,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PitchAxis,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PitchAxis)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PitchAxis))-1 ) = PACK(InData%PitchAxis,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PitchAxis) + DO i2 = LBOUND(InData%PitchAxis,2), UBOUND(InData%PitchAxis,2) + DO i1 = LBOUND(InData%PitchAxis,1), UBOUND(InData%PitchAxis,1) + ReKiBuf(Re_Xferred) = InData%PitchAxis(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%AeroTwst) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19273,8 +19160,10 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AeroTwst,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AeroTwst)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AeroTwst))-1 ) = PACK(InData%AeroTwst,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AeroTwst) + DO i1 = LBOUND(InData%AeroTwst,1), UBOUND(InData%AeroTwst,1) + ReKiBuf(Re_Xferred) = InData%AeroTwst(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%AxRedBld) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19295,8 +19184,16 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AxRedBld,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AxRedBld)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AxRedBld))-1 ) = PACK(InData%AxRedBld,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AxRedBld) + DO i4 = LBOUND(InData%AxRedBld,4), UBOUND(InData%AxRedBld,4) + DO i3 = LBOUND(InData%AxRedBld,3), UBOUND(InData%AxRedBld,3) + DO i2 = LBOUND(InData%AxRedBld,2), UBOUND(InData%AxRedBld,2) + DO i1 = LBOUND(InData%AxRedBld,1), UBOUND(InData%AxRedBld,1) + ReKiBuf(Re_Xferred) = InData%AxRedBld(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%BAlpha) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19311,8 +19208,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BAlpha,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BAlpha)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BAlpha))-1 ) = PACK(InData%BAlpha,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BAlpha) + DO i2 = LBOUND(InData%BAlpha,2), UBOUND(InData%BAlpha,2) + DO i1 = LBOUND(InData%BAlpha,1), UBOUND(InData%BAlpha,1) + ReKiBuf(Re_Xferred) = InData%BAlpha(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%BldEDamp) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19327,8 +19228,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldEDamp,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BldEDamp)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BldEDamp))-1 ) = PACK(InData%BldEDamp,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BldEDamp) + DO i2 = LBOUND(InData%BldEDamp,2), UBOUND(InData%BldEDamp,2) + DO i1 = LBOUND(InData%BldEDamp,1), UBOUND(InData%BldEDamp,1) + ReKiBuf(Re_Xferred) = InData%BldEDamp(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%BldFDamp) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19343,11 +19248,15 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldFDamp,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BldFDamp)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BldFDamp))-1 ) = PACK(InData%BldFDamp,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BldFDamp) + DO i2 = LBOUND(InData%BldFDamp,2), UBOUND(InData%BldFDamp,2) + DO i1 = LBOUND(InData%BldFDamp,1), UBOUND(InData%BldFDamp,1) + ReKiBuf(Re_Xferred) = InData%BldFDamp(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%BldFlexL - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%BldFlexL + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%CAeroTwst) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -19358,8 +19267,10 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CAeroTwst,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CAeroTwst)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CAeroTwst))-1 ) = PACK(InData%CAeroTwst,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CAeroTwst) + DO i1 = LBOUND(InData%CAeroTwst,1), UBOUND(InData%CAeroTwst,1) + ReKiBuf(Re_Xferred) = InData%CAeroTwst(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%CBE) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19377,8 +19288,14 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CBE,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CBE)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CBE))-1 ) = PACK(InData%CBE,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CBE) + DO i3 = LBOUND(InData%CBE,3), UBOUND(InData%CBE,3) + DO i2 = LBOUND(InData%CBE,2), UBOUND(InData%CBE,2) + DO i1 = LBOUND(InData%CBE,1), UBOUND(InData%CBE,1) + ReKiBuf(Re_Xferred) = InData%CBE(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%CBF) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19396,8 +19313,14 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CBF,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CBF)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CBF))-1 ) = PACK(InData%CBF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CBF) + DO i3 = LBOUND(InData%CBF,3), UBOUND(InData%CBF,3) + DO i2 = LBOUND(InData%CBF,2), UBOUND(InData%CBF,2) + DO i1 = LBOUND(InData%CBF,1), UBOUND(InData%CBF,1) + ReKiBuf(Re_Xferred) = InData%CBF(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%cgOffBEdg) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19412,8 +19335,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%cgOffBEdg,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%cgOffBEdg)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%cgOffBEdg))-1 ) = PACK(InData%cgOffBEdg,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%cgOffBEdg) + DO i2 = LBOUND(InData%cgOffBEdg,2), UBOUND(InData%cgOffBEdg,2) + DO i1 = LBOUND(InData%cgOffBEdg,1), UBOUND(InData%cgOffBEdg,1) + ReKiBuf(Re_Xferred) = InData%cgOffBEdg(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%cgOffBFlp) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19428,8 +19355,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%cgOffBFlp,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%cgOffBFlp)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%cgOffBFlp))-1 ) = PACK(InData%cgOffBFlp,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%cgOffBFlp) + DO i2 = LBOUND(InData%cgOffBFlp,2), UBOUND(InData%cgOffBFlp,2) + DO i1 = LBOUND(InData%cgOffBFlp,1), UBOUND(InData%cgOffBFlp,1) + ReKiBuf(Re_Xferred) = InData%cgOffBFlp(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Chord) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19441,8 +19372,10 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Chord,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Chord)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Chord))-1 ) = PACK(InData%Chord,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Chord) + DO i1 = LBOUND(InData%Chord,1), UBOUND(InData%Chord,1) + ReKiBuf(Re_Xferred) = InData%Chord(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%CThetaS) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19457,8 +19390,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CThetaS,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CThetaS)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%CThetaS))-1 ) = PACK(InData%CThetaS,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%CThetaS) + DO i2 = LBOUND(InData%CThetaS,2), UBOUND(InData%CThetaS,2) + DO i1 = LBOUND(InData%CThetaS,1), UBOUND(InData%CThetaS,1) + DbKiBuf(Db_Xferred) = InData%CThetaS(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%DRNodes) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19470,8 +19407,10 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DRNodes,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DRNodes)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%DRNodes))-1 ) = PACK(InData%DRNodes,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%DRNodes) + DO i1 = LBOUND(InData%DRNodes,1), UBOUND(InData%DRNodes,1) + ReKiBuf(Re_Xferred) = InData%DRNodes(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%EAOffBEdg) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19486,8 +19425,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%EAOffBEdg,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%EAOffBEdg)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%EAOffBEdg))-1 ) = PACK(InData%EAOffBEdg,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%EAOffBEdg) + DO i2 = LBOUND(InData%EAOffBEdg,2), UBOUND(InData%EAOffBEdg,2) + DO i1 = LBOUND(InData%EAOffBEdg,1), UBOUND(InData%EAOffBEdg,1) + ReKiBuf(Re_Xferred) = InData%EAOffBEdg(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%EAOffBFlp) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19502,8 +19445,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%EAOffBFlp,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%EAOffBFlp)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%EAOffBFlp))-1 ) = PACK(InData%EAOffBFlp,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%EAOffBFlp) + DO i2 = LBOUND(InData%EAOffBFlp,2), UBOUND(InData%EAOffBFlp,2) + DO i1 = LBOUND(InData%EAOffBFlp,1), UBOUND(InData%EAOffBFlp,1) + ReKiBuf(Re_Xferred) = InData%EAOffBFlp(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%FStTunr) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19518,8 +19465,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FStTunr,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FStTunr)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FStTunr))-1 ) = PACK(InData%FStTunr,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FStTunr) + DO i2 = LBOUND(InData%FStTunr,2), UBOUND(InData%FStTunr,2) + DO i1 = LBOUND(InData%FStTunr,1), UBOUND(InData%FStTunr,1) + ReKiBuf(Re_Xferred) = InData%FStTunr(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%InerBEdg) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19534,8 +19485,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InerBEdg,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%InerBEdg)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%InerBEdg))-1 ) = PACK(InData%InerBEdg,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%InerBEdg) + DO i2 = LBOUND(InData%InerBEdg,2), UBOUND(InData%InerBEdg,2) + DO i1 = LBOUND(InData%InerBEdg,1), UBOUND(InData%InerBEdg,1) + ReKiBuf(Re_Xferred) = InData%InerBEdg(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%InerBFlp) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19550,8 +19505,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InerBFlp,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%InerBFlp)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%InerBFlp))-1 ) = PACK(InData%InerBFlp,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%InerBFlp) + DO i2 = LBOUND(InData%InerBFlp,2), UBOUND(InData%InerBFlp,2) + DO i1 = LBOUND(InData%InerBFlp,1), UBOUND(InData%InerBFlp,1) + ReKiBuf(Re_Xferred) = InData%InerBFlp(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%KBE) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19569,8 +19528,14 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%KBE,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%KBE)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%KBE))-1 ) = PACK(InData%KBE,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%KBE) + DO i3 = LBOUND(InData%KBE,3), UBOUND(InData%KBE,3) + DO i2 = LBOUND(InData%KBE,2), UBOUND(InData%KBE,2) + DO i1 = LBOUND(InData%KBE,1), UBOUND(InData%KBE,1) + ReKiBuf(Re_Xferred) = InData%KBE(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%KBF) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19588,8 +19553,14 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%KBF,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%KBF)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%KBF))-1 ) = PACK(InData%KBF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%KBF) + DO i3 = LBOUND(InData%KBF,3), UBOUND(InData%KBF,3) + DO i2 = LBOUND(InData%KBF,2), UBOUND(InData%KBF,2) + DO i1 = LBOUND(InData%KBF,1), UBOUND(InData%KBF,1) + ReKiBuf(Re_Xferred) = InData%KBF(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%MassB) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19604,8 +19575,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MassB,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%MassB)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MassB))-1 ) = PACK(InData%MassB,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MassB) + DO i2 = LBOUND(InData%MassB,2), UBOUND(InData%MassB,2) + DO i1 = LBOUND(InData%MassB,1), UBOUND(InData%MassB,1) + ReKiBuf(Re_Xferred) = InData%MassB(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%RefAxisxb) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19620,8 +19595,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RefAxisxb,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RefAxisxb)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RefAxisxb))-1 ) = PACK(InData%RefAxisxb,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RefAxisxb) + DO i2 = LBOUND(InData%RefAxisxb,2), UBOUND(InData%RefAxisxb,2) + DO i1 = LBOUND(InData%RefAxisxb,1), UBOUND(InData%RefAxisxb,1) + ReKiBuf(Re_Xferred) = InData%RefAxisxb(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%RefAxisyb) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19636,8 +19615,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RefAxisyb,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RefAxisyb)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RefAxisyb))-1 ) = PACK(InData%RefAxisyb,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RefAxisyb) + DO i2 = LBOUND(InData%RefAxisyb,2), UBOUND(InData%RefAxisyb,2) + DO i1 = LBOUND(InData%RefAxisyb,1), UBOUND(InData%RefAxisyb,1) + ReKiBuf(Re_Xferred) = InData%RefAxisyb(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%RNodes) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19649,8 +19632,10 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RNodes,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RNodes)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RNodes))-1 ) = PACK(InData%RNodes,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RNodes) + DO i1 = LBOUND(InData%RNodes,1), UBOUND(InData%RNodes,1) + ReKiBuf(Re_Xferred) = InData%RNodes(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%RNodesNorm) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19662,8 +19647,10 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RNodesNorm,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RNodesNorm)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RNodesNorm))-1 ) = PACK(InData%RNodesNorm,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RNodesNorm) + DO i1 = LBOUND(InData%RNodesNorm,1), UBOUND(InData%RNodesNorm,1) + ReKiBuf(Re_Xferred) = InData%RNodesNorm(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%rSAerCenn1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19678,8 +19665,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rSAerCenn1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%rSAerCenn1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%rSAerCenn1))-1 ) = PACK(InData%rSAerCenn1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%rSAerCenn1) + DO i2 = LBOUND(InData%rSAerCenn1,2), UBOUND(InData%rSAerCenn1,2) + DO i1 = LBOUND(InData%rSAerCenn1,1), UBOUND(InData%rSAerCenn1,1) + ReKiBuf(Re_Xferred) = InData%rSAerCenn1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%rSAerCenn2) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19694,8 +19685,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rSAerCenn2,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%rSAerCenn2)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%rSAerCenn2))-1 ) = PACK(InData%rSAerCenn2,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%rSAerCenn2) + DO i2 = LBOUND(InData%rSAerCenn2,2), UBOUND(InData%rSAerCenn2,2) + DO i1 = LBOUND(InData%rSAerCenn2,1), UBOUND(InData%rSAerCenn2,1) + ReKiBuf(Re_Xferred) = InData%rSAerCenn2(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%SAeroTwst) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19707,8 +19702,10 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SAeroTwst,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%SAeroTwst)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SAeroTwst))-1 ) = PACK(InData%SAeroTwst,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SAeroTwst) + DO i1 = LBOUND(InData%SAeroTwst,1), UBOUND(InData%SAeroTwst,1) + ReKiBuf(Re_Xferred) = InData%SAeroTwst(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%StiffBE) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19723,8 +19720,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StiffBE,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%StiffBE)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%StiffBE))-1 ) = PACK(InData%StiffBE,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%StiffBE) + DO i2 = LBOUND(InData%StiffBE,2), UBOUND(InData%StiffBE,2) + DO i1 = LBOUND(InData%StiffBE,1), UBOUND(InData%StiffBE,1) + ReKiBuf(Re_Xferred) = InData%StiffBE(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%StiffBEA) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19739,8 +19740,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StiffBEA,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%StiffBEA)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%StiffBEA))-1 ) = PACK(InData%StiffBEA,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%StiffBEA) + DO i2 = LBOUND(InData%StiffBEA,2), UBOUND(InData%StiffBEA,2) + DO i1 = LBOUND(InData%StiffBEA,1), UBOUND(InData%StiffBEA,1) + ReKiBuf(Re_Xferred) = InData%StiffBEA(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%StiffBF) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19755,8 +19760,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StiffBF,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%StiffBF)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%StiffBF))-1 ) = PACK(InData%StiffBF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%StiffBF) + DO i2 = LBOUND(InData%StiffBF,2), UBOUND(InData%StiffBF,2) + DO i1 = LBOUND(InData%StiffBF,1), UBOUND(InData%StiffBF,1) + ReKiBuf(Re_Xferred) = InData%StiffBF(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%StiffBGJ) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19771,8 +19780,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StiffBGJ,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%StiffBGJ)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%StiffBGJ))-1 ) = PACK(InData%StiffBGJ,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%StiffBGJ) + DO i2 = LBOUND(InData%StiffBGJ,2), UBOUND(InData%StiffBGJ,2) + DO i1 = LBOUND(InData%StiffBGJ,1), UBOUND(InData%StiffBGJ,1) + ReKiBuf(Re_Xferred) = InData%StiffBGJ(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%SThetaS) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19787,8 +19800,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SThetaS,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%SThetaS)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%SThetaS))-1 ) = PACK(InData%SThetaS,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%SThetaS) + DO i2 = LBOUND(InData%SThetaS,2), UBOUND(InData%SThetaS,2) + DO i1 = LBOUND(InData%SThetaS,1), UBOUND(InData%SThetaS,1) + DbKiBuf(Db_Xferred) = InData%SThetaS(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%ThetaS) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19803,8 +19820,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ThetaS,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ThetaS)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%ThetaS))-1 ) = PACK(InData%ThetaS,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%ThetaS) + DO i2 = LBOUND(InData%ThetaS,2), UBOUND(InData%ThetaS,2) + DO i1 = LBOUND(InData%ThetaS,1), UBOUND(InData%ThetaS,1) + ReKiBuf(Re_Xferred) = InData%ThetaS(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%TwistedSF) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19828,8 +19849,18 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwistedSF,5) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwistedSF)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwistedSF))-1 ) = PACK(InData%TwistedSF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwistedSF) + DO i5 = LBOUND(InData%TwistedSF,5), UBOUND(InData%TwistedSF,5) + DO i4 = LBOUND(InData%TwistedSF,4), UBOUND(InData%TwistedSF,4) + DO i3 = LBOUND(InData%TwistedSF,3), UBOUND(InData%TwistedSF,3) + DO i2 = LBOUND(InData%TwistedSF,2), UBOUND(InData%TwistedSF,2) + DO i1 = LBOUND(InData%TwistedSF,1), UBOUND(InData%TwistedSF,1) + ReKiBuf(Re_Xferred) = InData%TwistedSF(i1,i2,i3,i4,i5) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%BldFl1Sh) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19844,8 +19875,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldFl1Sh,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BldFl1Sh)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BldFl1Sh))-1 ) = PACK(InData%BldFl1Sh,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BldFl1Sh) + DO i2 = LBOUND(InData%BldFl1Sh,2), UBOUND(InData%BldFl1Sh,2) + DO i1 = LBOUND(InData%BldFl1Sh,1), UBOUND(InData%BldFl1Sh,1) + ReKiBuf(Re_Xferred) = InData%BldFl1Sh(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%BldFl2Sh) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19860,8 +19895,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldFl2Sh,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BldFl2Sh)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BldFl2Sh))-1 ) = PACK(InData%BldFl2Sh,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BldFl2Sh) + DO i2 = LBOUND(InData%BldFl2Sh,2), UBOUND(InData%BldFl2Sh,2) + DO i1 = LBOUND(InData%BldFl2Sh,1), UBOUND(InData%BldFl2Sh,1) + ReKiBuf(Re_Xferred) = InData%BldFl2Sh(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%BldEdgSh) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19876,8 +19915,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldEdgSh,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BldEdgSh)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BldEdgSh))-1 ) = PACK(InData%BldEdgSh,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BldEdgSh) + DO i2 = LBOUND(InData%BldEdgSh,2), UBOUND(InData%BldEdgSh,2) + DO i1 = LBOUND(InData%BldEdgSh,1), UBOUND(InData%BldEdgSh,1) + ReKiBuf(Re_Xferred) = InData%BldEdgSh(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%FreqBE) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19895,8 +19938,14 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FreqBE,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FreqBE)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FreqBE))-1 ) = PACK(InData%FreqBE,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FreqBE) + DO i3 = LBOUND(InData%FreqBE,3), UBOUND(InData%FreqBE,3) + DO i2 = LBOUND(InData%FreqBE,2), UBOUND(InData%FreqBE,2) + DO i1 = LBOUND(InData%FreqBE,1), UBOUND(InData%FreqBE,1) + ReKiBuf(Re_Xferred) = InData%FreqBE(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%FreqBF) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -19914,99 +19963,117 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FreqBF,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FreqBF)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FreqBF))-1 ) = PACK(InData%FreqBF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FreqBF) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FreqTFA))-1 ) = PACK(InData%FreqTFA,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FreqTFA) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FreqTSS))-1 ) = PACK(InData%FreqTSS,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FreqTSS) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TeetCDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TeetDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TeetDmpP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TeetHSSp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TeetHStP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TeetSSSp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TeetSStP - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TeetMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlCDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlDSDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlDSDP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlDSSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlDSSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlUSDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlUSDP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlUSSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TFrlUSSpr - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TFrlMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlCDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlDSDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlDSDP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlDSSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlDSSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlUSDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlUSDP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlUSSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RFrlUSSpr - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%RFrlMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ShftGagL - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%BldGagNd))-1 ) = PACK(InData%BldGagNd,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%BldGagNd) - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%TwrGagNd))-1 ) = PACK(InData%TwrGagNd,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%TwrGagNd) - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%TStart - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DTTorDmp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DTTorSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GBRatio - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GBoxEff - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RotSpeed - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO i3 = LBOUND(InData%FreqBF,3), UBOUND(InData%FreqBF,3) + DO i2 = LBOUND(InData%FreqBF,2), UBOUND(InData%FreqBF,2) + DO i1 = LBOUND(InData%FreqBF,1), UBOUND(InData%FreqBF,1) + ReKiBuf(Re_Xferred) = InData%FreqBF(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + DO i2 = LBOUND(InData%FreqTFA,2), UBOUND(InData%FreqTFA,2) + DO i1 = LBOUND(InData%FreqTFA,1), UBOUND(InData%FreqTFA,1) + ReKiBuf(Re_Xferred) = InData%FreqTFA(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%FreqTSS,2), UBOUND(InData%FreqTSS,2) + DO i1 = LBOUND(InData%FreqTSS,1), UBOUND(InData%FreqTSS,1) + ReKiBuf(Re_Xferred) = InData%FreqTSS(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + ReKiBuf(Re_Xferred) = InData%TeetCDmp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TeetDmp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TeetDmpP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TeetHSSp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TeetHStP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TeetSSSp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TeetSStP + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TeetMod + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlCDmp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlDmp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlDSDmp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlDSDP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlDSSP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlDSSpr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlSpr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlUSDmp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlUSDP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlUSSP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TFrlUSSpr + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TFrlMod + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlCDmp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlDmp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlDSDmp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlDSDP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlDSSP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlDSSpr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlSpr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlUSDmp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlUSDP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlUSSP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RFrlUSSpr + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%RFrlMod + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%ShftGagL + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%BldGagNd,1), UBOUND(InData%BldGagNd,1) + IntKiBuf(Int_Xferred) = InData%BldGagNd(i1) + Int_Xferred = Int_Xferred + 1 + END DO + DO i1 = LBOUND(InData%TwrGagNd,1), UBOUND(InData%TwrGagNd,1) + IntKiBuf(Int_Xferred) = InData%TwrGagNd(i1) + Int_Xferred = Int_Xferred + 1 + END DO + DbKiBuf(Db_Xferred) = InData%TStart + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DTTorDmp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DTTorSpr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GBRatio + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GBoxEff + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RotSpeed + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( .NOT. ALLOCATED(InData%BElmntMass) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -20020,8 +20087,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BElmntMass,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BElmntMass)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BElmntMass))-1 ) = PACK(InData%BElmntMass,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BElmntMass) + DO i2 = LBOUND(InData%BElmntMass,2), UBOUND(InData%BElmntMass,2) + DO i1 = LBOUND(InData%BElmntMass,1), UBOUND(InData%BElmntMass,1) + ReKiBuf(Re_Xferred) = InData%BElmntMass(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%TElmntMass) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -20033,19 +20104,68 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TElmntMass,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TElmntMass)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TElmntMass))-1 ) = PACK(InData%TElmntMass,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TElmntMass) + DO i1 = LBOUND(InData%TElmntMass,1), UBOUND(InData%TElmntMass,1) + ReKiBuf(Re_Xferred) = InData%TElmntMass(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%method - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmCMxt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmCMyt - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%BD4Blades , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%UseAD14 , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%method + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmCMxt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmCMyt + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%BD4Blades, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%UseAD14, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%BldNd_NumOuts + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%BldNd_TotNumOuts + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%BldNd_OutParam) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BldNd_OutParam,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BldNd_OutParam,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%BldNd_OutParam,1), UBOUND(InData%BldNd_OutParam,1) + CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%BldNd_OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! BldNd_OutParam + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IntKiBuf(Int_Xferred) = InData%BldNd_BladesOut + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%Jac_u_indx) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -20059,8 +20179,12 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Jac_u_indx)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%Jac_u_indx))-1 ) = PACK(InData%Jac_u_indx,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%Jac_u_indx) + DO i2 = LBOUND(InData%Jac_u_indx,2), UBOUND(InData%Jac_u_indx,2) + DO i1 = LBOUND(InData%Jac_u_indx,1), UBOUND(InData%Jac_u_indx,1) + IntKiBuf(Int_Xferred) = InData%Jac_u_indx(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%du) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -20072,8 +20196,10 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%du,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%du)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%du))-1 ) = PACK(InData%du,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%du) + DO i1 = LBOUND(InData%du,1), UBOUND(InData%du,1) + DbKiBuf(Db_Xferred) = InData%du(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%dx) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -20085,11 +20211,13 @@ SUBROUTINE ED_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dx,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%dx)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%dx))-1 ) = PACK(InData%dx,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%dx) + DO i1 = LBOUND(InData%dx,1), UBOUND(InData%dx,1) + DbKiBuf(Db_Xferred) = InData%dx(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Jac_ny - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Jac_ny + Int_Xferred = Int_Xferred + 1 END SUBROUTINE ED_PackParam SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -20105,12 +20233,6 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (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 @@ -20129,22 +20251,22 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%DT24 = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%BldNodes = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TipNode = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NDOF = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TwoPiNB = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%NAug = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NPH = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%DT24 = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%BldNodes = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TipNode = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NDOF = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TwoPiNB = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%NAug = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NPH = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PH not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -20158,18 +20280,13 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PH.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%PH)>0) OutData%PH = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%PH))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%PH) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%PH,1), UBOUND(OutData%PH,1) + OutData%PH(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF - OutData%NPM = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NPM = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PM not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -20186,15 +20303,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PM.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PM)>0) OutData%PM = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%PM))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%PM) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PM,2), UBOUND(OutData%PM,2) + DO i1 = LBOUND(OutData%PM,1), UBOUND(OutData%PM,1) + OutData%PM(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DOF_Flag not allocated Int_Xferred = Int_Xferred + 1 @@ -20209,15 +20323,10 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DOF_Flag.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%DOF_Flag)>0) OutData%DOF_Flag = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%DOF_Flag))-1 ), OutData%DOF_Flag), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%DOF_Flag) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%DOF_Flag,1), UBOUND(OutData%DOF_Flag,1) + OutData%DOF_Flag(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%DOF_Flag(i1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DOF_Desc not allocated Int_Xferred = Int_Xferred + 1 @@ -20232,19 +20341,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DOF_Desc.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%DOF_Desc,1), UBOUND(OutData%DOF_Desc,1) + DO i1 = LBOUND(OutData%DOF_Desc,1), UBOUND(OutData%DOF_Desc,1) DO I = 1, LEN(OutData%DOF_Desc) OutData%DOF_Desc(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -20286,16 +20388,16 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutFmt) - OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%NBlGages = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NTwGages = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%OutFmt) + OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%NBlGages = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NTwGages = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParam not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -20352,16 +20454,16 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - DO I = 1, LEN(OutData%Delim) - OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%AvgNrmTpRd = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%AzimB1Up = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CosDel3 = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 + DO I = 1, LEN(OutData%Delim) + OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%AvgNrmTpRd = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%AzimB1Up = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%CosDel3 = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CosPreC not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -20375,118 +20477,113 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CosPreC.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%CosPreC)>0) OutData%CosPreC = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%CosPreC))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%CosPreC) - DEALLOCATE(mask1) - END IF - OutData%CRFrlSkew = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CRFrlSkw2 = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CRFrlTilt = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CRFrlTlt2 = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CShftSkew = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CShftTilt = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CSRFrlSkw = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CSRFrlTlt = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CSTFrlSkw = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CSTFrlTlt = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CTFinBank = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CTFinSkew = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CTFinTilt = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CTFrlSkew = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CTFrlSkw2 = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CTFrlTilt = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%CTFrlTlt2 = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%HubHt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HubCM = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HubRad = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NacCMxn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NacCMyn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NacCMzn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%OverHang = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%ProjArea = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmRefzt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RefTwrHt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlPntxn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlPntyn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlPntzn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rVDxn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rVDyn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rVDzn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rVIMUxn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rVIMUyn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rVIMUzn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rVPxn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rVPyn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rVPzn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rWIxn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rWIyn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rWIzn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rWJxn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rWJyn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rWJzn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rWKxn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rWKyn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rWKzn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rZT0zt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rZYzt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SinDel3 = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(OutData%CosPreC,1), UBOUND(OutData%CosPreC,1) + OutData%CosPreC(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + OutData%CRFrlSkew = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%CRFrlSkw2 = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%CRFrlTilt = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%CRFrlTlt2 = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%CShftSkew = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%CShftTilt = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%CSRFrlSkw = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%CSRFrlTlt = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%CSTFrlSkw = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%CSTFrlTlt = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%CTFinBank = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%CTFinSkew = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%CTFinTilt = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%CTFrlSkew = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%CTFrlSkw2 = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%CTFrlTilt = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%CTFrlTlt2 = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%HubHt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HubCM = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HubRad = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NacCMxn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NacCMyn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NacCMzn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%OverHang = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%ProjArea = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmRefzt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RefTwrHt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlPntxn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlPntyn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlPntzn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rVDxn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rVDyn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rVDzn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rVIMUxn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rVIMUyn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rVIMUzn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rVPxn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rVPyn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rVPzn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rWIxn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rWIyn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rWIzn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rWJxn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rWJyn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rWJzn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rWKxn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rWKyn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rWKzn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rZT0zt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rZYzt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SinDel3 = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SinPreC not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -20500,58 +20597,53 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SinPreC.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%SinPreC)>0) OutData%SinPreC = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%SinPreC))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%SinPreC) - DEALLOCATE(mask1) - END IF - OutData%SRFrlSkew = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%SRFrlSkw2 = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%SRFrlTilt = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%SRFrlTlt2 = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%SShftSkew = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%SShftTilt = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%STFinBank = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%STFinSkew = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%STFinTilt = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%STFrlSkew = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%STFrlSkw2 = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%STFrlTilt = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%STFrlTlt2 = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%TFrlPntxn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlPntyn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlPntzn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TipRad = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TowerHt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TowerBsHt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%UndSling = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NumBl = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%SinPreC,1), UBOUND(OutData%SinPreC,1) + OutData%SinPreC(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + OutData%SRFrlSkew = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%SRFrlSkw2 = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%SRFrlTilt = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%SRFrlTlt2 = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%SShftSkew = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%SShftTilt = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%STFinBank = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%STFinSkew = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%STFinTilt = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%STFrlSkew = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%STFrlSkw2 = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%STFrlTilt = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%STFrlTlt2 = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%TFrlPntxn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlPntyn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlPntzn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TipRad = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TowerHt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TowerBsHt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%UndSling = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NumBl = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AxRedTFA not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -20571,15 +20663,14 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AxRedTFA.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%AxRedTFA)>0) OutData%AxRedTFA = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AxRedTFA))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AxRedTFA) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%AxRedTFA,3), UBOUND(OutData%AxRedTFA,3) + DO i2 = LBOUND(OutData%AxRedTFA,2), UBOUND(OutData%AxRedTFA,2) + DO i1 = LBOUND(OutData%AxRedTFA,1), UBOUND(OutData%AxRedTFA,1) + OutData%AxRedTFA(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AxRedTSS not allocated Int_Xferred = Int_Xferred + 1 @@ -20600,42 +20691,35 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AxRedTSS.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%AxRedTSS)>0) OutData%AxRedTSS = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AxRedTSS))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AxRedTSS) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%AxRedTSS,3), UBOUND(OutData%AxRedTSS,3) + DO i2 = LBOUND(OutData%AxRedTSS,2), UBOUND(OutData%AxRedTSS,2) + DO i1 = LBOUND(OutData%AxRedTSS,1), UBOUND(OutData%AxRedTSS,1) + OutData%AxRedTSS(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF i1_l = LBOUND(OutData%CTFA,1) i1_u = UBOUND(OutData%CTFA,1) i2_l = LBOUND(OutData%CTFA,2) i2_u = UBOUND(OutData%CTFA,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%CTFA = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CTFA))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CTFA) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%CTFA,2), UBOUND(OutData%CTFA,2) + DO i1 = LBOUND(OutData%CTFA,1), UBOUND(OutData%CTFA,1) + OutData%CTFA(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%CTSS,1) i1_u = UBOUND(OutData%CTSS,1) i2_l = LBOUND(OutData%CTSS,2) i2_u = UBOUND(OutData%CTSS,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%CTSS = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CTSS))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CTSS) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%CTSS,2), UBOUND(OutData%CTSS,2) + DO i1 = LBOUND(OutData%CTSS,1), UBOUND(OutData%CTSS,1) + OutData%CTSS(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DHNodes not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -20649,15 +20733,10 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DHNodes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%DHNodes)>0) OutData%DHNodes = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%DHNodes))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%DHNodes) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%DHNodes,1), UBOUND(OutData%DHNodes,1) + OutData%DHNodes(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! HNodes not allocated Int_Xferred = Int_Xferred + 1 @@ -20672,15 +20751,10 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%HNodes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%HNodes)>0) OutData%HNodes = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%HNodes))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%HNodes) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%HNodes,1), UBOUND(OutData%HNodes,1) + OutData%HNodes(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! HNodesNorm not allocated Int_Xferred = Int_Xferred + 1 @@ -20695,42 +20769,31 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%HNodesNorm.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%HNodesNorm)>0) OutData%HNodesNorm = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%HNodesNorm))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%HNodesNorm) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%HNodesNorm,1), UBOUND(OutData%HNodesNorm,1) + OutData%HNodesNorm(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF i1_l = LBOUND(OutData%KTFA,1) i1_u = UBOUND(OutData%KTFA,1) i2_l = LBOUND(OutData%KTFA,2) i2_u = UBOUND(OutData%KTFA,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%KTFA = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%KTFA))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%KTFA) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%KTFA,2), UBOUND(OutData%KTFA,2) + DO i1 = LBOUND(OutData%KTFA,1), UBOUND(OutData%KTFA,1) + OutData%KTFA(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%KTSS,1) i1_u = UBOUND(OutData%KTSS,1) i2_l = LBOUND(OutData%KTSS,2) i2_u = UBOUND(OutData%KTSS,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%KTSS = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%KTSS))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%KTSS) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%KTSS,2), UBOUND(OutData%KTSS,2) + DO i1 = LBOUND(OutData%KTSS,1), UBOUND(OutData%KTSS,1) + OutData%KTSS(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MassT not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -20744,15 +20807,10 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MassT.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%MassT)>0) OutData%MassT = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MassT))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%MassT) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%MassT,1), UBOUND(OutData%MassT,1) + OutData%MassT(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StiffTSS not allocated Int_Xferred = Int_Xferred + 1 @@ -20767,15 +20825,10 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StiffTSS.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%StiffTSS)>0) OutData%StiffTSS = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%StiffTSS))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%StiffTSS) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%StiffTSS,1), UBOUND(OutData%StiffTSS,1) + OutData%StiffTSS(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrFASF not allocated Int_Xferred = Int_Xferred + 1 @@ -20796,18 +20849,17 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrFASF.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%TwrFASF)>0) OutData%TwrFASF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwrFASF))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwrFASF) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%TwrFASF,3), UBOUND(OutData%TwrFASF,3) + DO i2 = LBOUND(OutData%TwrFASF,2), UBOUND(OutData%TwrFASF,2) + DO i1 = LBOUND(OutData%TwrFASF,1), UBOUND(OutData%TwrFASF,1) + OutData%TwrFASF(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - OutData%TwrFlexL = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%TwrFlexL = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwrSSSF not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -20827,20 +20879,19 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrSSSF.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%TwrSSSF)>0) OutData%TwrSSSF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwrSSSF))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwrSSSF) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%TwrSSSF,3), UBOUND(OutData%TwrSSSF,3) + DO i2 = LBOUND(OutData%TwrSSSF,2), UBOUND(OutData%TwrSSSF,2) + DO i1 = LBOUND(OutData%TwrSSSF,1), UBOUND(OutData%TwrSSSF,1) + OutData%TwrSSSF(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - OutData%TTopNode = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TwrNodes = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%TTopNode = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TwrNodes = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InerTFA not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -20854,15 +20905,10 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InerTFA.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%InerTFA)>0) OutData%InerTFA = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%InerTFA))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%InerTFA) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%InerTFA,1), UBOUND(OutData%InerTFA,1) + OutData%InerTFA(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InerTSS not allocated Int_Xferred = Int_Xferred + 1 @@ -20877,15 +20923,10 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InerTSS.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%InerTSS)>0) OutData%InerTSS = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%InerTSS))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%InerTSS) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%InerTSS,1), UBOUND(OutData%InerTSS,1) + OutData%InerTSS(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StiffTGJ not allocated Int_Xferred = Int_Xferred + 1 @@ -20900,15 +20941,10 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StiffTGJ.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%StiffTGJ)>0) OutData%StiffTGJ = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%StiffTGJ))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%StiffTGJ) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%StiffTGJ,1), UBOUND(OutData%StiffTGJ,1) + OutData%StiffTGJ(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StiffTEA not allocated Int_Xferred = Int_Xferred + 1 @@ -20923,15 +20959,10 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StiffTEA.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%StiffTEA)>0) OutData%StiffTEA = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%StiffTEA))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%StiffTEA) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%StiffTEA,1), UBOUND(OutData%StiffTEA,1) + OutData%StiffTEA(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StiffTFA not allocated Int_Xferred = Int_Xferred + 1 @@ -20943,18 +20974,13 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg IF (ALLOCATED(OutData%StiffTFA)) DEALLOCATE(OutData%StiffTFA) ALLOCATE(OutData%StiffTFA(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StiffTFA.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StiffTFA.', ErrStat, ErrMsg,RoutineName) RETURN END IF - mask1 = .TRUE. - IF (SIZE(OutData%StiffTFA)>0) OutData%StiffTFA = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%StiffTFA))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%StiffTFA) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%StiffTFA,1), UBOUND(OutData%StiffTFA,1) + OutData%StiffTFA(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! cgOffTFA not allocated Int_Xferred = Int_Xferred + 1 @@ -20969,15 +20995,10 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%cgOffTFA.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%cgOffTFA)>0) OutData%cgOffTFA = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%cgOffTFA))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%cgOffTFA) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%cgOffTFA,1), UBOUND(OutData%cgOffTFA,1) + OutData%cgOffTFA(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! cgOffTSS not allocated Int_Xferred = Int_Xferred + 1 @@ -20992,18 +21013,13 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%cgOffTSS.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%cgOffTSS)>0) OutData%cgOffTSS = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%cgOffTSS))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%cgOffTSS) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%cgOffTSS,1), UBOUND(OutData%cgOffTSS,1) + OutData%cgOffTSS(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%AtfaIner = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%AtfaIner = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldCG not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -21017,15 +21033,10 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldCG.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BldCG)>0) OutData%BldCG = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BldCG))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BldCG) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BldCG,1), UBOUND(OutData%BldCG,1) + OutData%BldCG(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldMass not allocated Int_Xferred = Int_Xferred + 1 @@ -21040,18 +21051,13 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldMass.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BldMass)>0) OutData%BldMass = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BldMass))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BldMass) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BldMass,1), UBOUND(OutData%BldMass,1) + OutData%BldMass(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%BoomMass = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%BoomMass = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FirstMom not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -21065,44 +21071,39 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FirstMom.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%FirstMom)>0) OutData%FirstMom = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FirstMom))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FirstMom) - DEALLOCATE(mask1) - END IF - OutData%GenIner = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Hubg1Iner = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Hubg2Iner = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HubMass = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Nacd2Iner = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NacMass = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmMass = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmPIner = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmRIner = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmYIner = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlMass = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RotIner = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RotMass = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RrfaIner = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%FirstMom,1), UBOUND(OutData%FirstMom,1) + OutData%FirstMom(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%GenIner = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Hubg1Iner = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Hubg2Iner = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HubMass = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Nacd2Iner = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NacMass = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmMass = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmPIner = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmRIner = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmYIner = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlMass = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RotIner = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RotMass = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RrfaIner = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SecondMom not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -21116,20 +21117,15 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SecondMom.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%SecondMom)>0) OutData%SecondMom = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SecondMom))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SecondMom) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%SecondMom,1), UBOUND(OutData%SecondMom,1) + OutData%SecondMom(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%TFinMass = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlIner = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%TFinMass = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlIner = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TipMass not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -21143,26 +21139,21 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TipMass.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TipMass)>0) OutData%TipMass = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TipMass))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TipMass) - DEALLOCATE(mask1) - END IF - OutData%TurbMass = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TwrMass = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TwrTpMass = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawBrMass = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Gravity = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%TipMass,1), UBOUND(OutData%TipMass,1) + OutData%TipMass(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%TurbMass = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TwrMass = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TwrTpMass = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawBrMass = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Gravity = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PitchAxis not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -21179,15 +21170,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PitchAxis.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PitchAxis)>0) OutData%PitchAxis = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PitchAxis))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PitchAxis) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PitchAxis,2), UBOUND(OutData%PitchAxis,2) + DO i1 = LBOUND(OutData%PitchAxis,1), UBOUND(OutData%PitchAxis,1) + OutData%PitchAxis(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AeroTwst not allocated Int_Xferred = Int_Xferred + 1 @@ -21202,15 +21190,10 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AeroTwst.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%AeroTwst)>0) OutData%AeroTwst = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AeroTwst))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AeroTwst) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AeroTwst,1), UBOUND(OutData%AeroTwst,1) + OutData%AeroTwst(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AxRedBld not allocated Int_Xferred = Int_Xferred + 1 @@ -21234,15 +21217,16 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AxRedBld.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%AxRedBld)>0) OutData%AxRedBld = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AxRedBld))-1 ), mask4, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AxRedBld) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%AxRedBld,4), UBOUND(OutData%AxRedBld,4) + DO i3 = LBOUND(OutData%AxRedBld,3), UBOUND(OutData%AxRedBld,3) + DO i2 = LBOUND(OutData%AxRedBld,2), UBOUND(OutData%AxRedBld,2) + DO i1 = LBOUND(OutData%AxRedBld,1), UBOUND(OutData%AxRedBld,1) + OutData%AxRedBld(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BAlpha not allocated Int_Xferred = Int_Xferred + 1 @@ -21260,15 +21244,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BAlpha.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%BAlpha)>0) OutData%BAlpha = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BAlpha))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BAlpha) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%BAlpha,2), UBOUND(OutData%BAlpha,2) + DO i1 = LBOUND(OutData%BAlpha,1), UBOUND(OutData%BAlpha,1) + OutData%BAlpha(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldEDamp not allocated Int_Xferred = Int_Xferred + 1 @@ -21286,15 +21267,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldEDamp.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%BldEDamp)>0) OutData%BldEDamp = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BldEDamp))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BldEDamp) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%BldEDamp,2), UBOUND(OutData%BldEDamp,2) + DO i1 = LBOUND(OutData%BldEDamp,1), UBOUND(OutData%BldEDamp,1) + OutData%BldEDamp(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldFDamp not allocated Int_Xferred = Int_Xferred + 1 @@ -21312,18 +21290,15 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldFDamp.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%BldFDamp)>0) OutData%BldFDamp = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BldFDamp))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BldFDamp) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%BldFDamp,2), UBOUND(OutData%BldFDamp,2) + DO i1 = LBOUND(OutData%BldFDamp,1), UBOUND(OutData%BldFDamp,1) + OutData%BldFDamp(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - OutData%BldFlexL = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%BldFlexL = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CAeroTwst not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -21337,15 +21312,10 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CAeroTwst.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%CAeroTwst)>0) OutData%CAeroTwst = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CAeroTwst))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CAeroTwst) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%CAeroTwst,1), UBOUND(OutData%CAeroTwst,1) + OutData%CAeroTwst(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CBE not allocated Int_Xferred = Int_Xferred + 1 @@ -21366,15 +21336,14 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CBE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%CBE)>0) OutData%CBE = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CBE))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CBE) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%CBE,3), UBOUND(OutData%CBE,3) + DO i2 = LBOUND(OutData%CBE,2), UBOUND(OutData%CBE,2) + DO i1 = LBOUND(OutData%CBE,1), UBOUND(OutData%CBE,1) + OutData%CBE(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CBF not allocated Int_Xferred = Int_Xferred + 1 @@ -21395,15 +21364,14 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CBF.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%CBF)>0) OutData%CBF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CBF))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CBF) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%CBF,3), UBOUND(OutData%CBF,3) + DO i2 = LBOUND(OutData%CBF,2), UBOUND(OutData%CBF,2) + DO i1 = LBOUND(OutData%CBF,1), UBOUND(OutData%CBF,1) + OutData%CBF(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! cgOffBEdg not allocated Int_Xferred = Int_Xferred + 1 @@ -21421,15 +21389,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%cgOffBEdg.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%cgOffBEdg)>0) OutData%cgOffBEdg = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%cgOffBEdg))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%cgOffBEdg) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%cgOffBEdg,2), UBOUND(OutData%cgOffBEdg,2) + DO i1 = LBOUND(OutData%cgOffBEdg,1), UBOUND(OutData%cgOffBEdg,1) + OutData%cgOffBEdg(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! cgOffBFlp not allocated Int_Xferred = Int_Xferred + 1 @@ -21447,15 +21412,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%cgOffBFlp.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%cgOffBFlp)>0) OutData%cgOffBFlp = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%cgOffBFlp))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%cgOffBFlp) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%cgOffBFlp,2), UBOUND(OutData%cgOffBFlp,2) + DO i1 = LBOUND(OutData%cgOffBFlp,1), UBOUND(OutData%cgOffBFlp,1) + OutData%cgOffBFlp(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Chord not allocated Int_Xferred = Int_Xferred + 1 @@ -21470,15 +21432,10 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Chord.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Chord)>0) OutData%Chord = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Chord))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Chord) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Chord,1), UBOUND(OutData%Chord,1) + OutData%Chord(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CThetaS not allocated Int_Xferred = Int_Xferred + 1 @@ -21496,15 +21453,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CThetaS.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%CThetaS)>0) OutData%CThetaS = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%CThetaS))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%CThetaS) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%CThetaS,2), UBOUND(OutData%CThetaS,2) + DO i1 = LBOUND(OutData%CThetaS,1), UBOUND(OutData%CThetaS,1) + OutData%CThetaS(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DRNodes not allocated Int_Xferred = Int_Xferred + 1 @@ -21519,15 +21473,10 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DRNodes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%DRNodes)>0) OutData%DRNodes = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%DRNodes))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%DRNodes) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%DRNodes,1), UBOUND(OutData%DRNodes,1) + OutData%DRNodes(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! EAOffBEdg not allocated Int_Xferred = Int_Xferred + 1 @@ -21545,15 +21494,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%EAOffBEdg.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%EAOffBEdg)>0) OutData%EAOffBEdg = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%EAOffBEdg))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%EAOffBEdg) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%EAOffBEdg,2), UBOUND(OutData%EAOffBEdg,2) + DO i1 = LBOUND(OutData%EAOffBEdg,1), UBOUND(OutData%EAOffBEdg,1) + OutData%EAOffBEdg(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! EAOffBFlp not allocated Int_Xferred = Int_Xferred + 1 @@ -21571,15 +21517,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%EAOffBFlp.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%EAOffBFlp)>0) OutData%EAOffBFlp = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%EAOffBFlp))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%EAOffBFlp) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%EAOffBFlp,2), UBOUND(OutData%EAOffBFlp,2) + DO i1 = LBOUND(OutData%EAOffBFlp,1), UBOUND(OutData%EAOffBFlp,1) + OutData%EAOffBFlp(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FStTunr not allocated Int_Xferred = Int_Xferred + 1 @@ -21597,15 +21540,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FStTunr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%FStTunr)>0) OutData%FStTunr = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FStTunr))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FStTunr) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%FStTunr,2), UBOUND(OutData%FStTunr,2) + DO i1 = LBOUND(OutData%FStTunr,1), UBOUND(OutData%FStTunr,1) + OutData%FStTunr(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InerBEdg not allocated Int_Xferred = Int_Xferred + 1 @@ -21623,15 +21563,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InerBEdg.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%InerBEdg)>0) OutData%InerBEdg = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%InerBEdg))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%InerBEdg) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%InerBEdg,2), UBOUND(OutData%InerBEdg,2) + DO i1 = LBOUND(OutData%InerBEdg,1), UBOUND(OutData%InerBEdg,1) + OutData%InerBEdg(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InerBFlp not allocated Int_Xferred = Int_Xferred + 1 @@ -21649,15 +21586,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InerBFlp.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%InerBFlp)>0) OutData%InerBFlp = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%InerBFlp))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%InerBFlp) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%InerBFlp,2), UBOUND(OutData%InerBFlp,2) + DO i1 = LBOUND(OutData%InerBFlp,1), UBOUND(OutData%InerBFlp,1) + OutData%InerBFlp(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! KBE not allocated Int_Xferred = Int_Xferred + 1 @@ -21678,15 +21612,14 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%KBE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%KBE)>0) OutData%KBE = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%KBE))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%KBE) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%KBE,3), UBOUND(OutData%KBE,3) + DO i2 = LBOUND(OutData%KBE,2), UBOUND(OutData%KBE,2) + DO i1 = LBOUND(OutData%KBE,1), UBOUND(OutData%KBE,1) + OutData%KBE(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! KBF not allocated Int_Xferred = Int_Xferred + 1 @@ -21707,15 +21640,14 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%KBF.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%KBF)>0) OutData%KBF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%KBF))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%KBF) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%KBF,3), UBOUND(OutData%KBF,3) + DO i2 = LBOUND(OutData%KBF,2), UBOUND(OutData%KBF,2) + DO i1 = LBOUND(OutData%KBF,1), UBOUND(OutData%KBF,1) + OutData%KBF(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MassB not allocated Int_Xferred = Int_Xferred + 1 @@ -21733,15 +21665,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MassB.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%MassB)>0) OutData%MassB = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MassB))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%MassB) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%MassB,2), UBOUND(OutData%MassB,2) + DO i1 = LBOUND(OutData%MassB,1), UBOUND(OutData%MassB,1) + OutData%MassB(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RefAxisxb not allocated Int_Xferred = Int_Xferred + 1 @@ -21759,15 +21688,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RefAxisxb.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%RefAxisxb)>0) OutData%RefAxisxb = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RefAxisxb))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RefAxisxb) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%RefAxisxb,2), UBOUND(OutData%RefAxisxb,2) + DO i1 = LBOUND(OutData%RefAxisxb,1), UBOUND(OutData%RefAxisxb,1) + OutData%RefAxisxb(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RefAxisyb not allocated Int_Xferred = Int_Xferred + 1 @@ -21785,15 +21711,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RefAxisyb.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%RefAxisyb)>0) OutData%RefAxisyb = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RefAxisyb))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RefAxisyb) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%RefAxisyb,2), UBOUND(OutData%RefAxisyb,2) + DO i1 = LBOUND(OutData%RefAxisyb,1), UBOUND(OutData%RefAxisyb,1) + OutData%RefAxisyb(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RNodes not allocated Int_Xferred = Int_Xferred + 1 @@ -21808,15 +21731,10 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RNodes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%RNodes)>0) OutData%RNodes = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RNodes))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RNodes) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%RNodes,1), UBOUND(OutData%RNodes,1) + OutData%RNodes(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RNodesNorm not allocated Int_Xferred = Int_Xferred + 1 @@ -21831,15 +21749,10 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RNodesNorm.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%RNodesNorm)>0) OutData%RNodesNorm = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RNodesNorm))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RNodesNorm) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%RNodesNorm,1), UBOUND(OutData%RNodesNorm,1) + OutData%RNodesNorm(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rSAerCenn1 not allocated Int_Xferred = Int_Xferred + 1 @@ -21857,15 +21770,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rSAerCenn1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%rSAerCenn1)>0) OutData%rSAerCenn1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%rSAerCenn1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%rSAerCenn1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%rSAerCenn1,2), UBOUND(OutData%rSAerCenn1,2) + DO i1 = LBOUND(OutData%rSAerCenn1,1), UBOUND(OutData%rSAerCenn1,1) + OutData%rSAerCenn1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rSAerCenn2 not allocated Int_Xferred = Int_Xferred + 1 @@ -21883,15 +21793,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rSAerCenn2.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%rSAerCenn2)>0) OutData%rSAerCenn2 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%rSAerCenn2))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%rSAerCenn2) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%rSAerCenn2,2), UBOUND(OutData%rSAerCenn2,2) + DO i1 = LBOUND(OutData%rSAerCenn2,1), UBOUND(OutData%rSAerCenn2,1) + OutData%rSAerCenn2(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SAeroTwst not allocated Int_Xferred = Int_Xferred + 1 @@ -21906,15 +21813,10 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SAeroTwst.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%SAeroTwst)>0) OutData%SAeroTwst = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SAeroTwst))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SAeroTwst) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%SAeroTwst,1), UBOUND(OutData%SAeroTwst,1) + OutData%SAeroTwst(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StiffBE not allocated Int_Xferred = Int_Xferred + 1 @@ -21932,15 +21834,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StiffBE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%StiffBE)>0) OutData%StiffBE = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%StiffBE))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%StiffBE) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%StiffBE,2), UBOUND(OutData%StiffBE,2) + DO i1 = LBOUND(OutData%StiffBE,1), UBOUND(OutData%StiffBE,1) + OutData%StiffBE(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StiffBEA not allocated Int_Xferred = Int_Xferred + 1 @@ -21958,15 +21857,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StiffBEA.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%StiffBEA)>0) OutData%StiffBEA = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%StiffBEA))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%StiffBEA) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%StiffBEA,2), UBOUND(OutData%StiffBEA,2) + DO i1 = LBOUND(OutData%StiffBEA,1), UBOUND(OutData%StiffBEA,1) + OutData%StiffBEA(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StiffBF not allocated Int_Xferred = Int_Xferred + 1 @@ -21984,15 +21880,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StiffBF.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%StiffBF)>0) OutData%StiffBF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%StiffBF))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%StiffBF) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%StiffBF,2), UBOUND(OutData%StiffBF,2) + DO i1 = LBOUND(OutData%StiffBF,1), UBOUND(OutData%StiffBF,1) + OutData%StiffBF(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StiffBGJ not allocated Int_Xferred = Int_Xferred + 1 @@ -22010,15 +21903,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StiffBGJ.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%StiffBGJ)>0) OutData%StiffBGJ = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%StiffBGJ))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%StiffBGJ) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%StiffBGJ,2), UBOUND(OutData%StiffBGJ,2) + DO i1 = LBOUND(OutData%StiffBGJ,1), UBOUND(OutData%StiffBGJ,1) + OutData%StiffBGJ(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SThetaS not allocated Int_Xferred = Int_Xferred + 1 @@ -22036,15 +21926,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SThetaS.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%SThetaS)>0) OutData%SThetaS = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%SThetaS))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%SThetaS) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%SThetaS,2), UBOUND(OutData%SThetaS,2) + DO i1 = LBOUND(OutData%SThetaS,1), UBOUND(OutData%SThetaS,1) + OutData%SThetaS(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ThetaS not allocated Int_Xferred = Int_Xferred + 1 @@ -22062,15 +21949,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ThetaS.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%ThetaS)>0) OutData%ThetaS = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%ThetaS))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%ThetaS) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%ThetaS,2), UBOUND(OutData%ThetaS,2) + DO i1 = LBOUND(OutData%ThetaS,1), UBOUND(OutData%ThetaS,1) + OutData%ThetaS(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TwistedSF not allocated Int_Xferred = Int_Xferred + 1 @@ -22097,15 +21981,18 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwistedSF.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask5(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask5.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask5 = .TRUE. - IF (SIZE(OutData%TwistedSF)>0) OutData%TwistedSF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwistedSF))-1 ), mask5, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwistedSF) - DEALLOCATE(mask5) + DO i5 = LBOUND(OutData%TwistedSF,5), UBOUND(OutData%TwistedSF,5) + DO i4 = LBOUND(OutData%TwistedSF,4), UBOUND(OutData%TwistedSF,4) + DO i3 = LBOUND(OutData%TwistedSF,3), UBOUND(OutData%TwistedSF,3) + DO i2 = LBOUND(OutData%TwistedSF,2), UBOUND(OutData%TwistedSF,2) + DO i1 = LBOUND(OutData%TwistedSF,1), UBOUND(OutData%TwistedSF,1) + OutData%TwistedSF(i1,i2,i3,i4,i5) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldFl1Sh not allocated Int_Xferred = Int_Xferred + 1 @@ -22123,15 +22010,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldFl1Sh.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%BldFl1Sh)>0) OutData%BldFl1Sh = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BldFl1Sh))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BldFl1Sh) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%BldFl1Sh,2), UBOUND(OutData%BldFl1Sh,2) + DO i1 = LBOUND(OutData%BldFl1Sh,1), UBOUND(OutData%BldFl1Sh,1) + OutData%BldFl1Sh(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldFl2Sh not allocated Int_Xferred = Int_Xferred + 1 @@ -22149,15 +22033,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldFl2Sh.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%BldFl2Sh)>0) OutData%BldFl2Sh = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BldFl2Sh))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BldFl2Sh) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%BldFl2Sh,2), UBOUND(OutData%BldFl2Sh,2) + DO i1 = LBOUND(OutData%BldFl2Sh,1), UBOUND(OutData%BldFl2Sh,1) + OutData%BldFl2Sh(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldEdgSh not allocated Int_Xferred = Int_Xferred + 1 @@ -22175,15 +22056,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldEdgSh.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%BldEdgSh)>0) OutData%BldEdgSh = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BldEdgSh))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BldEdgSh) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%BldEdgSh,2), UBOUND(OutData%BldEdgSh,2) + DO i1 = LBOUND(OutData%BldEdgSh,1), UBOUND(OutData%BldEdgSh,1) + OutData%BldEdgSh(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FreqBE not allocated Int_Xferred = Int_Xferred + 1 @@ -22204,15 +22082,14 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FreqBE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%FreqBE)>0) OutData%FreqBE = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FreqBE))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FreqBE) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%FreqBE,3), UBOUND(OutData%FreqBE,3) + DO i2 = LBOUND(OutData%FreqBE,2), UBOUND(OutData%FreqBE,2) + DO i1 = LBOUND(OutData%FreqBE,1), UBOUND(OutData%FreqBE,1) + OutData%FreqBE(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FreqBF not allocated Int_Xferred = Int_Xferred + 1 @@ -22233,146 +22110,129 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FreqBF.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%FreqBF)>0) OutData%FreqBF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FreqBF))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FreqBF) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%FreqBF,3), UBOUND(OutData%FreqBF,3) + DO i2 = LBOUND(OutData%FreqBF,2), UBOUND(OutData%FreqBF,2) + DO i1 = LBOUND(OutData%FreqBF,1), UBOUND(OutData%FreqBF,1) + OutData%FreqBF(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF i1_l = LBOUND(OutData%FreqTFA,1) i1_u = UBOUND(OutData%FreqTFA,1) i2_l = LBOUND(OutData%FreqTFA,2) i2_u = UBOUND(OutData%FreqTFA,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%FreqTFA = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FreqTFA))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FreqTFA) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%FreqTFA,2), UBOUND(OutData%FreqTFA,2) + DO i1 = LBOUND(OutData%FreqTFA,1), UBOUND(OutData%FreqTFA,1) + OutData%FreqTFA(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%FreqTSS,1) i1_u = UBOUND(OutData%FreqTSS,1) i2_l = LBOUND(OutData%FreqTSS,2) i2_u = UBOUND(OutData%FreqTSS,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%FreqTSS = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FreqTSS))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FreqTSS) - DEALLOCATE(mask2) - OutData%TeetCDmp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TeetDmp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TeetDmpP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TeetHSSp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TeetHStP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TeetSSSp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TeetSStP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TeetMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TFrlCDmp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlDmp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlDSDmp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlDSDP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlDSSP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlDSSpr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlSpr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlUSDmp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlUSDP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlUSSP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlUSSpr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TFrlMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%RFrlCDmp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlDmp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlDSDmp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlDSDP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlDSSP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlDSSpr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlSpr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlUSDmp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlUSDP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlUSSP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlUSSpr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RFrlMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%ShftGagL = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(OutData%FreqTSS,2), UBOUND(OutData%FreqTSS,2) + DO i1 = LBOUND(OutData%FreqTSS,1), UBOUND(OutData%FreqTSS,1) + OutData%FreqTSS(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + OutData%TeetCDmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TeetDmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TeetDmpP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TeetHSSp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TeetHStP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TeetSSSp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TeetSStP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TeetMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TFrlCDmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlDmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlDSDmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlDSDP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlDSSP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlDSSpr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlSpr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlUSDmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlUSDP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlUSSP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlUSSpr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TFrlMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%RFrlCDmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlDmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlDSDmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlDSDP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlDSSP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlDSSpr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlSpr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlUSDmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlUSDP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlUSSP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlUSSpr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RFrlMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ShftGagL = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%BldGagNd,1) i1_u = UBOUND(OutData%BldGagNd,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%BldGagNd = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%BldGagNd))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%BldGagNd) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BldGagNd,1), UBOUND(OutData%BldGagNd,1) + OutData%BldGagNd(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO i1_l = LBOUND(OutData%TwrGagNd,1) i1_u = UBOUND(OutData%TwrGagNd,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%TwrGagNd = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%TwrGagNd))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%TwrGagNd) - DEALLOCATE(mask1) - OutData%TStart = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%DTTorDmp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%DTTorSpr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GBRatio = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GBoxEff = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RotSpeed = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO i1 = LBOUND(OutData%TwrGagNd,1), UBOUND(OutData%TwrGagNd,1) + OutData%TwrGagNd(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + OutData%TStart = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%DTTorDmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%DTTorSpr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GBRatio = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GBoxEff = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RotSpeed = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BElmntMass not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -22389,15 +22249,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BElmntMass.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%BElmntMass)>0) OutData%BElmntMass = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BElmntMass))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BElmntMass) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%BElmntMass,2), UBOUND(OutData%BElmntMass,2) + DO i1 = LBOUND(OutData%BElmntMass,1), UBOUND(OutData%BElmntMass,1) + OutData%BElmntMass(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TElmntMass not allocated Int_Xferred = Int_Xferred + 1 @@ -22412,26 +22269,83 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TElmntMass.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) + DO i1 = LBOUND(OutData%TElmntMass,1), UBOUND(OutData%TElmntMass,1) + OutData%TElmntMass(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%method = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%PtfmCMxt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmCMyt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%BD4Blades = TRANSFER(IntKiBuf(Int_Xferred), OutData%BD4Blades) + Int_Xferred = Int_Xferred + 1 + OutData%UseAD14 = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseAD14) + Int_Xferred = Int_Xferred + 1 + OutData%BldNd_NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%BldNd_TotNumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BldNd_OutParam not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BldNd_OutParam)) DEALLOCATE(OutData%BldNd_OutParam) + ALLOCATE(OutData%BldNd_OutParam(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BldNd_OutParam.', ErrStat, ErrMsg,RoutineName) RETURN END IF - mask1 = .TRUE. - IF (SIZE(OutData%TElmntMass)>0) OutData%TElmntMass = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TElmntMass))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TElmntMass) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BldNd_OutParam,1), UBOUND(OutData%BldNd_OutParam,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackoutparmtype( Re_Buf, Db_Buf, Int_Buf, OutData%BldNd_OutParam(i1), ErrStat2, ErrMsg2 ) ! BldNd_OutParam + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO END IF - OutData%method = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmCMxt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmCMyt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%BD4Blades = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%UseAD14 = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%BldNd_BladesOut = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_u_indx not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -22448,15 +22362,12 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Jac_u_indx)>0) OutData%Jac_u_indx = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%Jac_u_indx))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%Jac_u_indx) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Jac_u_indx,2), UBOUND(OutData%Jac_u_indx,2) + DO i1 = LBOUND(OutData%Jac_u_indx,1), UBOUND(OutData%Jac_u_indx,1) + OutData%Jac_u_indx(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! du not allocated Int_Xferred = Int_Xferred + 1 @@ -22471,15 +22382,10 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%du.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%du)>0) OutData%du = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%du))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%du) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%du,1), UBOUND(OutData%du,1) + OutData%du(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dx not allocated Int_Xferred = Int_Xferred + 1 @@ -22494,18 +22400,13 @@ SUBROUTINE ED_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dx.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%dx)>0) OutData%dx = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%dx))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%dx) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%dx,1), UBOUND(OutData%dx,1) + OutData%dx(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO END IF - OutData%Jac_ny = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%Jac_ny = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE ED_UnPackParam SUBROUTINE ED_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -22951,11 +22852,21 @@ SUBROUTINE ED_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TwrAddedMass,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TwrAddedMass)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TwrAddedMass))-1 ) = PACK(InData%TwrAddedMass,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TwrAddedMass) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PtfmAddedMass))-1 ) = PACK(InData%PtfmAddedMass,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PtfmAddedMass) + DO i3 = LBOUND(InData%TwrAddedMass,3), UBOUND(InData%TwrAddedMass,3) + DO i2 = LBOUND(InData%TwrAddedMass,2), UBOUND(InData%TwrAddedMass,2) + DO i1 = LBOUND(InData%TwrAddedMass,1), UBOUND(InData%TwrAddedMass,1) + ReKiBuf(Re_Xferred) = InData%TwrAddedMass(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + DO i2 = LBOUND(InData%PtfmAddedMass,2), UBOUND(InData%PtfmAddedMass,2) + DO i1 = LBOUND(InData%PtfmAddedMass,1), UBOUND(InData%PtfmAddedMass,1) + ReKiBuf(Re_Xferred) = InData%PtfmAddedMass(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO IF ( .NOT. ALLOCATED(InData%BlPitchCom) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -22966,15 +22877,17 @@ SUBROUTINE ED_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlPitchCom,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BlPitchCom)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlPitchCom))-1 ) = PACK(InData%BlPitchCom,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlPitchCom) + DO i1 = LBOUND(InData%BlPitchCom,1), UBOUND(InData%BlPitchCom,1) + ReKiBuf(Re_Xferred) = InData%BlPitchCom(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawMom - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GenTrq - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HSSBrTrqC - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawMom + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GenTrq + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HSSBrTrqC + Re_Xferred = Re_Xferred + 1 END SUBROUTINE ED_PackInput SUBROUTINE ED_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -22990,12 +22903,6 @@ SUBROUTINE ED_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (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 @@ -23247,29 +23154,25 @@ SUBROUTINE ED_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TwrAddedMass.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%TwrAddedMass)>0) OutData%TwrAddedMass = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TwrAddedMass))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TwrAddedMass) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%TwrAddedMass,3), UBOUND(OutData%TwrAddedMass,3) + DO i2 = LBOUND(OutData%TwrAddedMass,2), UBOUND(OutData%TwrAddedMass,2) + DO i1 = LBOUND(OutData%TwrAddedMass,1), UBOUND(OutData%TwrAddedMass,1) + OutData%TwrAddedMass(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF i1_l = LBOUND(OutData%PtfmAddedMass,1) i1_u = UBOUND(OutData%PtfmAddedMass,1) i2_l = LBOUND(OutData%PtfmAddedMass,2) i2_u = UBOUND(OutData%PtfmAddedMass,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%PtfmAddedMass = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PtfmAddedMass))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PtfmAddedMass) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PtfmAddedMass,2), UBOUND(OutData%PtfmAddedMass,2) + DO i1 = LBOUND(OutData%PtfmAddedMass,1), UBOUND(OutData%PtfmAddedMass,1) + OutData%PtfmAddedMass(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlPitchCom not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -23283,22 +23186,17 @@ SUBROUTINE ED_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitchCom.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BlPitchCom)>0) OutData%BlPitchCom = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlPitchCom))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlPitchCom) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BlPitchCom,1), UBOUND(OutData%BlPitchCom,1) + OutData%BlPitchCom(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%YawMom = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GenTrq = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HSSBrTrqC = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%YawMom = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GenTrq = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HSSBrTrqC = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE ED_UnPackInput SUBROUTINE ED_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -24052,8 +23950,10 @@ SUBROUTINE ED_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WriteOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WriteOutput))-1 ) = PACK(InData%WriteOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WriteOutput) + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%BlPitch) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -24065,55 +23965,61 @@ SUBROUTINE ED_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlPitch,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BlPitch)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlPitch))-1 ) = PACK(InData%BlPitch,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlPitch) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Yaw - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawRate - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%LSS_Spd - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HSS_Spd - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RotSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TwrAccel - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawAngle - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RootMyc))-1 ) = PACK(InData%RootMyc,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RootMyc) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawBrTAxp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawBrTAyp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%LSSTipPxa - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RootMxc))-1 ) = PACK(InData%RootMxc,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RootMxc) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%LSSTipMxa - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%LSSTipMya - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%LSSTipMza - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%LSSTipMys - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%LSSTipMzs - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawBrMyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawBrMzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NcIMURAxs - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NcIMURAys - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NcIMURAzs - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RotPwr - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%BlPitch,1), UBOUND(InData%BlPitch,1) + ReKiBuf(Re_Xferred) = InData%BlPitch(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%Yaw + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawRate + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%LSS_Spd + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HSS_Spd + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RotSpeed + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TwrAccel + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawAngle + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%RootMyc,1), UBOUND(InData%RootMyc,1) + ReKiBuf(Re_Xferred) = InData%RootMyc(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%YawBrTAxp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawBrTAyp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%LSSTipPxa + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%RootMxc,1), UBOUND(InData%RootMxc,1) + ReKiBuf(Re_Xferred) = InData%RootMxc(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%LSSTipMxa + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%LSSTipMya + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%LSSTipMza + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%LSSTipMys + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%LSSTipMzs + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawBrMyn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawBrMzn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NcIMURAxs + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NcIMURAys + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NcIMURAzs + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RotPwr + Re_Xferred = Re_Xferred + 1 END SUBROUTINE ED_PackOutput SUBROUTINE ED_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -24129,12 +24035,6 @@ SUBROUTINE ED_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -24594,15 +24494,10 @@ SUBROUTINE ED_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WriteOutput)>0) OutData%WriteOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WriteOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WriteOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlPitch not allocated Int_Xferred = Int_Xferred + 1 @@ -24617,80 +24512,65 @@ SUBROUTINE ED_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitch.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BlPitch)>0) OutData%BlPitch = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlPitch))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlPitch) - DEALLOCATE(mask1) - END IF - OutData%Yaw = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawRate = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%LSS_Spd = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HSS_Spd = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RotSpeed = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TwrAccel = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawAngle = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%BlPitch,1), UBOUND(OutData%BlPitch,1) + OutData%BlPitch(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%Yaw = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawRate = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LSS_Spd = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HSS_Spd = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RotSpeed = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TwrAccel = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawAngle = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%RootMyc,1) i1_u = UBOUND(OutData%RootMyc,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%RootMyc = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RootMyc))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RootMyc) - DEALLOCATE(mask1) - OutData%YawBrTAxp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawBrTAyp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipPxa = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%RootMyc,1), UBOUND(OutData%RootMyc,1) + OutData%RootMyc(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%YawBrTAxp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawBrTAyp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LSSTipPxa = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%RootMxc,1) i1_u = UBOUND(OutData%RootMxc,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%RootMxc = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RootMxc))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RootMxc) - DEALLOCATE(mask1) - OutData%LSSTipMxa = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipMya = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipMza = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipMys = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipMzs = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawBrMyn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawBrMzn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NcIMURAxs = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NcIMURAys = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NcIMURAzs = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RotPwr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%RootMxc,1), UBOUND(OutData%RootMxc,1) + OutData%RootMxc(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%LSSTipMxa = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LSSTipMya = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LSSTipMza = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LSSTipMys = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LSSTipMzs = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawBrMyn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawBrMzn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NcIMURAxs = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NcIMURAys = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NcIMURAzs = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RotPwr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE ED_UnPackOutput @@ -24768,17 +24648,16 @@ SUBROUTINE ED_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'ED_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: b3 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: c3 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + INTEGER :: i3 ! dim3 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -24791,9 +24670,11 @@ SUBROUTINE ED_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) IF (ALLOCATED(u_out%BladePtLoads) .AND. ALLOCATED(u1%BladePtLoads)) THEN - DO i01 = LBOUND(u_out%BladePtLoads,1),UBOUND(u_out%BladePtLoads,1) - CALL MeshExtrapInterp1(u1%BladePtLoads(i01), u2%BladePtLoads(i01), tin, u_out%BladePtLoads(i01), tin_out, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(u_out%BladePtLoads,1),UBOUND(u_out%BladePtLoads,1) + CALL MeshExtrapInterp1(u1%BladePtLoads(i1), u2%BladePtLoads(i1), tin, u_out%BladePtLoads(i1), tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) ENDDO END IF ! check if allocated @@ -24806,35 +24687,32 @@ SUBROUTINE ED_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) CALL MeshExtrapInterp1(u1%NacelleLoads, u2%NacelleLoads, tin, u_out%NacelleLoads, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(u_out%TwrAddedMass) .AND. ALLOCATED(u1%TwrAddedMass)) THEN - ALLOCATE(b3(SIZE(u_out%TwrAddedMass,1),SIZE(u_out%TwrAddedMass,2), & - SIZE(u_out%TwrAddedMass,3) )) - ALLOCATE(c3(SIZE(u_out%TwrAddedMass,1),SIZE(u_out%TwrAddedMass,2), & - SIZE(u_out%TwrAddedMass,3) )) - b3 = -(u1%TwrAddedMass - u2%TwrAddedMass)/t(2) - u_out%TwrAddedMass = u1%TwrAddedMass + b3 * t_out - DEALLOCATE(b3) - DEALLOCATE(c3) + DO i3 = LBOUND(u_out%TwrAddedMass,3),UBOUND(u_out%TwrAddedMass,3) + DO i2 = LBOUND(u_out%TwrAddedMass,2),UBOUND(u_out%TwrAddedMass,2) + DO i1 = LBOUND(u_out%TwrAddedMass,1),UBOUND(u_out%TwrAddedMass,1) + b = -(u1%TwrAddedMass(i1,i2,i3) - u2%TwrAddedMass(i1,i2,i3)) + u_out%TwrAddedMass(i1,i2,i3) = u1%TwrAddedMass(i1,i2,i3) + b * ScaleFactor + END DO + END DO + END DO END IF ! check if allocated - ALLOCATE(b2(SIZE(u_out%PtfmAddedMass,1),SIZE(u_out%PtfmAddedMass,2) )) - ALLOCATE(c2(SIZE(u_out%PtfmAddedMass,1),SIZE(u_out%PtfmAddedMass,2) )) - b2 = -(u1%PtfmAddedMass - u2%PtfmAddedMass)/t(2) - u_out%PtfmAddedMass = u1%PtfmAddedMass + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%PtfmAddedMass,2),UBOUND(u_out%PtfmAddedMass,2) + DO i1 = LBOUND(u_out%PtfmAddedMass,1),UBOUND(u_out%PtfmAddedMass,1) + b = -(u1%PtfmAddedMass(i1,i2) - u2%PtfmAddedMass(i1,i2)) + u_out%PtfmAddedMass(i1,i2) = u1%PtfmAddedMass(i1,i2) + b * ScaleFactor + END DO + END DO IF (ALLOCATED(u_out%BlPitchCom) .AND. ALLOCATED(u1%BlPitchCom)) THEN - ALLOCATE(b1(SIZE(u_out%BlPitchCom,1))) - ALLOCATE(c1(SIZE(u_out%BlPitchCom,1))) - b1 = -(u1%BlPitchCom - u2%BlPitchCom)/t(2) - u_out%BlPitchCom = u1%BlPitchCom + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%BlPitchCom,1),UBOUND(u_out%BlPitchCom,1) + CALL Angles_ExtrapInterp( u1%BlPitchCom(i1), u2%BlPitchCom(i1), tin, u_out%BlPitchCom(i1), tin_out ) + END DO END IF ! check if allocated - b0 = -(u1%YawMom - u2%YawMom)/t(2) - u_out%YawMom = u1%YawMom + b0 * t_out - b0 = -(u1%GenTrq - u2%GenTrq)/t(2) - u_out%GenTrq = u1%GenTrq + b0 * t_out - b0 = -(u1%HSSBrTrqC - u2%HSSBrTrqC)/t(2) - u_out%HSSBrTrqC = u1%HSSBrTrqC + b0 * t_out + b = -(u1%YawMom - u2%YawMom) + u_out%YawMom = u1%YawMom + b * ScaleFactor + b = -(u1%GenTrq - u2%GenTrq) + u_out%GenTrq = u1%GenTrq + b * ScaleFactor + b = -(u1%HSSBrTrqC - u2%HSSBrTrqC) + u_out%HSSBrTrqC = u1%HSSBrTrqC + b * ScaleFactor END SUBROUTINE ED_Input_ExtrapInterp1 @@ -24864,18 +24742,18 @@ SUBROUTINE ED_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: b3 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: c3 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'ED_Input_ExtrapInterp2' INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i03 ! dim3 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays + INTEGER :: i3 ! dim3 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -24894,9 +24772,11 @@ SUBROUTINE ED_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) IF (ALLOCATED(u_out%BladePtLoads) .AND. ALLOCATED(u1%BladePtLoads)) THEN - DO i01 = LBOUND(u_out%BladePtLoads,1),UBOUND(u_out%BladePtLoads,1) - CALL MeshExtrapInterp2(u1%BladePtLoads(i01), u2%BladePtLoads(i01), u3%BladePtLoads(i01), tin, u_out%BladePtLoads(i01), tin_out, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(u_out%BladePtLoads,1),UBOUND(u_out%BladePtLoads,1) + CALL MeshExtrapInterp2(u1%BladePtLoads(i1), u2%BladePtLoads(i1), u3%BladePtLoads(i1), tin, u_out%BladePtLoads(i1), tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) ENDDO END IF ! check if allocated @@ -24909,41 +24789,37 @@ SUBROUTINE ED_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM CALL MeshExtrapInterp2(u1%NacelleLoads, u2%NacelleLoads, u3%NacelleLoads, tin, u_out%NacelleLoads, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(u_out%TwrAddedMass) .AND. ALLOCATED(u1%TwrAddedMass)) THEN - ALLOCATE(b3(SIZE(u_out%TwrAddedMass,1),SIZE(u_out%TwrAddedMass,2), & - SIZE(u_out%TwrAddedMass,3) )) - ALLOCATE(c3(SIZE(u_out%TwrAddedMass,1),SIZE(u_out%TwrAddedMass,2), & - SIZE(u_out%TwrAddedMass,3) )) - b3 = (t(3)**2*(u1%TwrAddedMass - u2%TwrAddedMass) + t(2)**2*(-u1%TwrAddedMass + u3%TwrAddedMass))/(t(2)*t(3)*(t(2) - t(3))) - c3 = ( (t(2)-t(3))*u1%TwrAddedMass + t(3)*u2%TwrAddedMass - t(2)*u3%TwrAddedMass ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TwrAddedMass = u1%TwrAddedMass + b3 * t_out + c3 * t_out**2 - DEALLOCATE(b3) - DEALLOCATE(c3) + DO i3 = LBOUND(u_out%TwrAddedMass,3),UBOUND(u_out%TwrAddedMass,3) + DO i2 = LBOUND(u_out%TwrAddedMass,2),UBOUND(u_out%TwrAddedMass,2) + DO i1 = LBOUND(u_out%TwrAddedMass,1),UBOUND(u_out%TwrAddedMass,1) + b = (t(3)**2*(u1%TwrAddedMass(i1,i2,i3) - u2%TwrAddedMass(i1,i2,i3)) + t(2)**2*(-u1%TwrAddedMass(i1,i2,i3) + u3%TwrAddedMass(i1,i2,i3)))* scaleFactor + c = ( (t(2)-t(3))*u1%TwrAddedMass(i1,i2,i3) + t(3)*u2%TwrAddedMass(i1,i2,i3) - t(2)*u3%TwrAddedMass(i1,i2,i3) ) * scaleFactor + u_out%TwrAddedMass(i1,i2,i3) = u1%TwrAddedMass(i1,i2,i3) + b + c * t_out + END DO + END DO + END DO END IF ! check if allocated - ALLOCATE(b2(SIZE(u_out%PtfmAddedMass,1),SIZE(u_out%PtfmAddedMass,2) )) - ALLOCATE(c2(SIZE(u_out%PtfmAddedMass,1),SIZE(u_out%PtfmAddedMass,2) )) - b2 = (t(3)**2*(u1%PtfmAddedMass - u2%PtfmAddedMass) + t(2)**2*(-u1%PtfmAddedMass + u3%PtfmAddedMass))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%PtfmAddedMass + t(3)*u2%PtfmAddedMass - t(2)*u3%PtfmAddedMass ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%PtfmAddedMass = u1%PtfmAddedMass + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%PtfmAddedMass,2),UBOUND(u_out%PtfmAddedMass,2) + DO i1 = LBOUND(u_out%PtfmAddedMass,1),UBOUND(u_out%PtfmAddedMass,1) + b = (t(3)**2*(u1%PtfmAddedMass(i1,i2) - u2%PtfmAddedMass(i1,i2)) + t(2)**2*(-u1%PtfmAddedMass(i1,i2) + u3%PtfmAddedMass(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%PtfmAddedMass(i1,i2) + t(3)*u2%PtfmAddedMass(i1,i2) - t(2)*u3%PtfmAddedMass(i1,i2) ) * scaleFactor + u_out%PtfmAddedMass(i1,i2) = u1%PtfmAddedMass(i1,i2) + b + c * t_out + END DO + END DO IF (ALLOCATED(u_out%BlPitchCom) .AND. ALLOCATED(u1%BlPitchCom)) THEN - ALLOCATE(b1(SIZE(u_out%BlPitchCom,1))) - ALLOCATE(c1(SIZE(u_out%BlPitchCom,1))) - b1 = (t(3)**2*(u1%BlPitchCom - u2%BlPitchCom) + t(2)**2*(-u1%BlPitchCom + u3%BlPitchCom))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%BlPitchCom + t(3)*u2%BlPitchCom - t(2)*u3%BlPitchCom ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%BlPitchCom = u1%BlPitchCom + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%BlPitchCom,1),UBOUND(u_out%BlPitchCom,1) + CALL Angles_ExtrapInterp( u1%BlPitchCom(i1), u2%BlPitchCom(i1), u3%BlPitchCom(i1), tin, u_out%BlPitchCom(i1), tin_out ) + END DO END IF ! check if allocated - b0 = (t(3)**2*(u1%YawMom - u2%YawMom) + t(2)**2*(-u1%YawMom + u3%YawMom))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%YawMom + t(3)*u2%YawMom - t(2)*u3%YawMom ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%YawMom = u1%YawMom + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%GenTrq - u2%GenTrq) + t(2)**2*(-u1%GenTrq + u3%GenTrq))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%GenTrq + t(3)*u2%GenTrq - t(2)*u3%GenTrq ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%GenTrq = u1%GenTrq + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%HSSBrTrqC - u2%HSSBrTrqC) + t(2)**2*(-u1%HSSBrTrqC + u3%HSSBrTrqC))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%HSSBrTrqC + t(3)*u2%HSSBrTrqC - t(2)*u3%HSSBrTrqC ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%HSSBrTrqC = u1%HSSBrTrqC + b0 * t_out + c0 * t_out**2 + b = (t(3)**2*(u1%YawMom - u2%YawMom) + t(2)**2*(-u1%YawMom + u3%YawMom))* scaleFactor + c = ( (t(2)-t(3))*u1%YawMom + t(3)*u2%YawMom - t(2)*u3%YawMom ) * scaleFactor + u_out%YawMom = u1%YawMom + b + c * t_out + b = (t(3)**2*(u1%GenTrq - u2%GenTrq) + t(2)**2*(-u1%GenTrq + u3%GenTrq))* scaleFactor + c = ( (t(2)-t(3))*u1%GenTrq + t(3)*u2%GenTrq - t(2)*u3%GenTrq ) * scaleFactor + u_out%GenTrq = u1%GenTrq + b + c * t_out + b = (t(3)**2*(u1%HSSBrTrqC - u2%HSSBrTrqC) + t(2)**2*(-u1%HSSBrTrqC + u3%HSSBrTrqC))* scaleFactor + c = ( (t(2)-t(3))*u1%HSSBrTrqC + t(3)*u2%HSSBrTrqC - t(2)*u3%HSSBrTrqC ) * scaleFactor + u_out%HSSBrTrqC = u1%HSSBrTrqC + b + c * t_out END SUBROUTINE ED_Input_ExtrapInterp2 @@ -25021,13 +24897,12 @@ SUBROUTINE ED_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'ED_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -25040,9 +24915,11 @@ SUBROUTINE ED_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) IF (ALLOCATED(y_out%BladeLn2Mesh) .AND. ALLOCATED(y1%BladeLn2Mesh)) THEN - DO i01 = LBOUND(y_out%BladeLn2Mesh,1),UBOUND(y_out%BladeLn2Mesh,1) - CALL MeshExtrapInterp1(y1%BladeLn2Mesh(i01), y2%BladeLn2Mesh(i01), tin, y_out%BladeLn2Mesh(i01), tin_out, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(y_out%BladeLn2Mesh,1),UBOUND(y_out%BladeLn2Mesh,1) + CALL MeshExtrapInterp1(y1%BladeLn2Mesh(i1), y2%BladeLn2Mesh(i1), tin, y_out%BladeLn2Mesh(i1), tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) ENDDO END IF ! check if allocated @@ -25057,8 +24934,8 @@ SUBROUTINE ED_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg CALL MeshExtrapInterp1(y1%BladeRootMotion14, y2%BladeRootMotion14, tin, y_out%BladeRootMotion14, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%BladeRootMotion) .AND. ALLOCATED(y1%BladeRootMotion)) THEN - DO i01 = LBOUND(y_out%BladeRootMotion,1),UBOUND(y_out%BladeRootMotion,1) - CALL MeshExtrapInterp1(y1%BladeRootMotion(i01), y2%BladeRootMotion(i01), tin, y_out%BladeRootMotion(i01), tin_out, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(y_out%BladeRootMotion,1),UBOUND(y_out%BladeRootMotion,1) + CALL MeshExtrapInterp1(y1%BladeRootMotion(i1), y2%BladeRootMotion(i1), tin, y_out%BladeRootMotion(i1), tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) ENDDO END IF ! check if allocated @@ -25069,75 +24946,63 @@ SUBROUTINE ED_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg CALL MeshExtrapInterp1(y1%TowerBaseMotion14, y2%TowerBaseMotion14, tin, y_out%TowerBaseMotion14, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = -(y1%WriteOutput - y2%WriteOutput)/t(2) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ALLOCATED(y_out%BlPitch) .AND. ALLOCATED(y1%BlPitch)) THEN - ALLOCATE(b1(SIZE(y_out%BlPitch,1))) - ALLOCATE(c1(SIZE(y_out%BlPitch,1))) - b1 = -(y1%BlPitch - y2%BlPitch)/t(2) - y_out%BlPitch = y1%BlPitch + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%BlPitch,1),UBOUND(y_out%BlPitch,1) + CALL Angles_ExtrapInterp( y1%BlPitch(i1), y2%BlPitch(i1), tin, y_out%BlPitch(i1), tin_out ) + END DO END IF ! check if allocated - b0 = -(y1%Yaw - y2%Yaw)/t(2) - y_out%Yaw = y1%Yaw + b0 * t_out - b0 = -(y1%YawRate - y2%YawRate)/t(2) - y_out%YawRate = y1%YawRate + b0 * t_out - b0 = -(y1%LSS_Spd - y2%LSS_Spd)/t(2) - y_out%LSS_Spd = y1%LSS_Spd + b0 * t_out - b0 = -(y1%HSS_Spd - y2%HSS_Spd)/t(2) - y_out%HSS_Spd = y1%HSS_Spd + b0 * t_out - b0 = -(y1%RotSpeed - y2%RotSpeed)/t(2) - y_out%RotSpeed = y1%RotSpeed + b0 * t_out - b0 = -(y1%TwrAccel - y2%TwrAccel)/t(2) - y_out%TwrAccel = y1%TwrAccel + b0 * t_out - b0 = -(y1%YawAngle - y2%YawAngle)/t(2) - y_out%YawAngle = y1%YawAngle + b0 * t_out - ALLOCATE(b1(SIZE(y_out%RootMyc,1))) - ALLOCATE(c1(SIZE(y_out%RootMyc,1))) - b1 = -(y1%RootMyc - y2%RootMyc)/t(2) - y_out%RootMyc = y1%RootMyc + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - b0 = -(y1%YawBrTAxp - y2%YawBrTAxp)/t(2) - y_out%YawBrTAxp = y1%YawBrTAxp + b0 * t_out - b0 = -(y1%YawBrTAyp - y2%YawBrTAyp)/t(2) - y_out%YawBrTAyp = y1%YawBrTAyp + b0 * t_out - b0 = -(y1%LSSTipPxa - y2%LSSTipPxa)/t(2) - y_out%LSSTipPxa = y1%LSSTipPxa + b0 * t_out - ALLOCATE(b1(SIZE(y_out%RootMxc,1))) - ALLOCATE(c1(SIZE(y_out%RootMxc,1))) - b1 = -(y1%RootMxc - y2%RootMxc)/t(2) - y_out%RootMxc = y1%RootMxc + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - b0 = -(y1%LSSTipMxa - y2%LSSTipMxa)/t(2) - y_out%LSSTipMxa = y1%LSSTipMxa + b0 * t_out - b0 = -(y1%LSSTipMya - y2%LSSTipMya)/t(2) - y_out%LSSTipMya = y1%LSSTipMya + b0 * t_out - b0 = -(y1%LSSTipMza - y2%LSSTipMza)/t(2) - y_out%LSSTipMza = y1%LSSTipMza + b0 * t_out - b0 = -(y1%LSSTipMys - y2%LSSTipMys)/t(2) - y_out%LSSTipMys = y1%LSSTipMys + b0 * t_out - b0 = -(y1%LSSTipMzs - y2%LSSTipMzs)/t(2) - y_out%LSSTipMzs = y1%LSSTipMzs + b0 * t_out - b0 = -(y1%YawBrMyn - y2%YawBrMyn)/t(2) - y_out%YawBrMyn = y1%YawBrMyn + b0 * t_out - b0 = -(y1%YawBrMzn - y2%YawBrMzn)/t(2) - y_out%YawBrMzn = y1%YawBrMzn + b0 * t_out - b0 = -(y1%NcIMURAxs - y2%NcIMURAxs)/t(2) - y_out%NcIMURAxs = y1%NcIMURAxs + b0 * t_out - b0 = -(y1%NcIMURAys - y2%NcIMURAys)/t(2) - y_out%NcIMURAys = y1%NcIMURAys + b0 * t_out - b0 = -(y1%NcIMURAzs - y2%NcIMURAzs)/t(2) - y_out%NcIMURAzs = y1%NcIMURAzs + b0 * t_out - b0 = -(y1%RotPwr - y2%RotPwr)/t(2) - y_out%RotPwr = y1%RotPwr + b0 * t_out + CALL Angles_ExtrapInterp( y1%Yaw, y2%Yaw, tin, y_out%Yaw, tin_out ) + b = -(y1%YawRate - y2%YawRate) + y_out%YawRate = y1%YawRate + b * ScaleFactor + b = -(y1%LSS_Spd - y2%LSS_Spd) + y_out%LSS_Spd = y1%LSS_Spd + b * ScaleFactor + b = -(y1%HSS_Spd - y2%HSS_Spd) + y_out%HSS_Spd = y1%HSS_Spd + b * ScaleFactor + b = -(y1%RotSpeed - y2%RotSpeed) + y_out%RotSpeed = y1%RotSpeed + b * ScaleFactor + b = -(y1%TwrAccel - y2%TwrAccel) + y_out%TwrAccel = y1%TwrAccel + b * ScaleFactor + CALL Angles_ExtrapInterp( y1%YawAngle, y2%YawAngle, tin, y_out%YawAngle, tin_out ) + DO i1 = LBOUND(y_out%RootMyc,1),UBOUND(y_out%RootMyc,1) + b = -(y1%RootMyc(i1) - y2%RootMyc(i1)) + y_out%RootMyc(i1) = y1%RootMyc(i1) + b * ScaleFactor + END DO + b = -(y1%YawBrTAxp - y2%YawBrTAxp) + y_out%YawBrTAxp = y1%YawBrTAxp + b * ScaleFactor + b = -(y1%YawBrTAyp - y2%YawBrTAyp) + y_out%YawBrTAyp = y1%YawBrTAyp + b * ScaleFactor + CALL Angles_ExtrapInterp( y1%LSSTipPxa, y2%LSSTipPxa, tin, y_out%LSSTipPxa, tin_out ) + DO i1 = LBOUND(y_out%RootMxc,1),UBOUND(y_out%RootMxc,1) + b = -(y1%RootMxc(i1) - y2%RootMxc(i1)) + y_out%RootMxc(i1) = y1%RootMxc(i1) + b * ScaleFactor + END DO + b = -(y1%LSSTipMxa - y2%LSSTipMxa) + y_out%LSSTipMxa = y1%LSSTipMxa + b * ScaleFactor + b = -(y1%LSSTipMya - y2%LSSTipMya) + y_out%LSSTipMya = y1%LSSTipMya + b * ScaleFactor + b = -(y1%LSSTipMza - y2%LSSTipMza) + y_out%LSSTipMza = y1%LSSTipMza + b * ScaleFactor + b = -(y1%LSSTipMys - y2%LSSTipMys) + y_out%LSSTipMys = y1%LSSTipMys + b * ScaleFactor + b = -(y1%LSSTipMzs - y2%LSSTipMzs) + y_out%LSSTipMzs = y1%LSSTipMzs + b * ScaleFactor + b = -(y1%YawBrMyn - y2%YawBrMyn) + y_out%YawBrMyn = y1%YawBrMyn + b * ScaleFactor + b = -(y1%YawBrMzn - y2%YawBrMzn) + y_out%YawBrMzn = y1%YawBrMzn + b * ScaleFactor + b = -(y1%NcIMURAxs - y2%NcIMURAxs) + y_out%NcIMURAxs = y1%NcIMURAxs + b * ScaleFactor + b = -(y1%NcIMURAys - y2%NcIMURAys) + y_out%NcIMURAys = y1%NcIMURAys + b * ScaleFactor + b = -(y1%NcIMURAzs - y2%NcIMURAzs) + y_out%NcIMURAzs = y1%NcIMURAzs + b * ScaleFactor + b = -(y1%RotPwr - y2%RotPwr) + y_out%RotPwr = y1%RotPwr + b * ScaleFactor END SUBROUTINE ED_Output_ExtrapInterp1 @@ -25167,14 +25032,14 @@ SUBROUTINE ED_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'ED_Output_ExtrapInterp2' INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -25193,9 +25058,11 @@ SUBROUTINE ED_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) IF (ALLOCATED(y_out%BladeLn2Mesh) .AND. ALLOCATED(y1%BladeLn2Mesh)) THEN - DO i01 = LBOUND(y_out%BladeLn2Mesh,1),UBOUND(y_out%BladeLn2Mesh,1) - CALL MeshExtrapInterp2(y1%BladeLn2Mesh(i01), y2%BladeLn2Mesh(i01), y3%BladeLn2Mesh(i01), tin, y_out%BladeLn2Mesh(i01), tin_out, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(y_out%BladeLn2Mesh,1),UBOUND(y_out%BladeLn2Mesh,1) + CALL MeshExtrapInterp2(y1%BladeLn2Mesh(i1), y2%BladeLn2Mesh(i1), y3%BladeLn2Mesh(i1), tin, y_out%BladeLn2Mesh(i1), tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) ENDDO END IF ! check if allocated @@ -25210,8 +25077,8 @@ SUBROUTINE ED_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err CALL MeshExtrapInterp2(y1%BladeRootMotion14, y2%BladeRootMotion14, y3%BladeRootMotion14, tin, y_out%BladeRootMotion14, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%BladeRootMotion) .AND. ALLOCATED(y1%BladeRootMotion)) THEN - DO i01 = LBOUND(y_out%BladeRootMotion,1),UBOUND(y_out%BladeRootMotion,1) - CALL MeshExtrapInterp2(y1%BladeRootMotion(i01), y2%BladeRootMotion(i01), y3%BladeRootMotion(i01), tin, y_out%BladeRootMotion(i01), tin_out, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(y_out%BladeRootMotion,1),UBOUND(y_out%BladeRootMotion,1) + CALL MeshExtrapInterp2(y1%BladeRootMotion(i1), y2%BladeRootMotion(i1), y3%BladeRootMotion(i1), tin, y_out%BladeRootMotion(i1), tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) ENDDO END IF ! check if allocated @@ -25222,100 +25089,84 @@ SUBROUTINE ED_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err CALL MeshExtrapInterp2(y1%TowerBaseMotion14, y2%TowerBaseMotion14, y3%TowerBaseMotion14, tin, y_out%TowerBaseMotion14, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = (t(3)**2*(y1%WriteOutput - y2%WriteOutput) + t(2)**2*(-y1%WriteOutput + y3%WriteOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WriteOutput + t(3)*y2%WriteOutput - t(2)*y3%WriteOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ALLOCATED(y_out%BlPitch) .AND. ALLOCATED(y1%BlPitch)) THEN - ALLOCATE(b1(SIZE(y_out%BlPitch,1))) - ALLOCATE(c1(SIZE(y_out%BlPitch,1))) - b1 = (t(3)**2*(y1%BlPitch - y2%BlPitch) + t(2)**2*(-y1%BlPitch + y3%BlPitch))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%BlPitch + t(3)*y2%BlPitch - t(2)*y3%BlPitch ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%BlPitch = y1%BlPitch + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%BlPitch,1),UBOUND(y_out%BlPitch,1) + CALL Angles_ExtrapInterp( y1%BlPitch(i1), y2%BlPitch(i1), y3%BlPitch(i1), tin, y_out%BlPitch(i1), tin_out ) + END DO END IF ! check if allocated - b0 = (t(3)**2*(y1%Yaw - y2%Yaw) + t(2)**2*(-y1%Yaw + y3%Yaw))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%Yaw + t(3)*y2%Yaw - t(2)*y3%Yaw ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Yaw = y1%Yaw + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%YawRate - y2%YawRate) + t(2)**2*(-y1%YawRate + y3%YawRate))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%YawRate + t(3)*y2%YawRate - t(2)*y3%YawRate ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%YawRate = y1%YawRate + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%LSS_Spd - y2%LSS_Spd) + t(2)**2*(-y1%LSS_Spd + y3%LSS_Spd))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%LSS_Spd + t(3)*y2%LSS_Spd - t(2)*y3%LSS_Spd ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%LSS_Spd = y1%LSS_Spd + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%HSS_Spd - y2%HSS_Spd) + t(2)**2*(-y1%HSS_Spd + y3%HSS_Spd))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%HSS_Spd + t(3)*y2%HSS_Spd - t(2)*y3%HSS_Spd ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%HSS_Spd = y1%HSS_Spd + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%RotSpeed - y2%RotSpeed) + t(2)**2*(-y1%RotSpeed + y3%RotSpeed))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%RotSpeed + t(3)*y2%RotSpeed - t(2)*y3%RotSpeed ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%RotSpeed = y1%RotSpeed + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%TwrAccel - y2%TwrAccel) + t(2)**2*(-y1%TwrAccel + y3%TwrAccel))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%TwrAccel + t(3)*y2%TwrAccel - t(2)*y3%TwrAccel ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%TwrAccel = y1%TwrAccel + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%YawAngle - y2%YawAngle) + t(2)**2*(-y1%YawAngle + y3%YawAngle))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%YawAngle + t(3)*y2%YawAngle - t(2)*y3%YawAngle ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%YawAngle = y1%YawAngle + b0 * t_out + c0 * t_out**2 - ALLOCATE(b1(SIZE(y_out%RootMyc,1))) - ALLOCATE(c1(SIZE(y_out%RootMyc,1))) - b1 = (t(3)**2*(y1%RootMyc - y2%RootMyc) + t(2)**2*(-y1%RootMyc + y3%RootMyc))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%RootMyc + t(3)*y2%RootMyc - t(2)*y3%RootMyc ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%RootMyc = y1%RootMyc + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - b0 = (t(3)**2*(y1%YawBrTAxp - y2%YawBrTAxp) + t(2)**2*(-y1%YawBrTAxp + y3%YawBrTAxp))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%YawBrTAxp + t(3)*y2%YawBrTAxp - t(2)*y3%YawBrTAxp ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%YawBrTAxp = y1%YawBrTAxp + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%YawBrTAyp - y2%YawBrTAyp) + t(2)**2*(-y1%YawBrTAyp + y3%YawBrTAyp))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%YawBrTAyp + t(3)*y2%YawBrTAyp - t(2)*y3%YawBrTAyp ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%YawBrTAyp = y1%YawBrTAyp + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%LSSTipPxa - y2%LSSTipPxa) + t(2)**2*(-y1%LSSTipPxa + y3%LSSTipPxa))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%LSSTipPxa + t(3)*y2%LSSTipPxa - t(2)*y3%LSSTipPxa ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%LSSTipPxa = y1%LSSTipPxa + b0 * t_out + c0 * t_out**2 - ALLOCATE(b1(SIZE(y_out%RootMxc,1))) - ALLOCATE(c1(SIZE(y_out%RootMxc,1))) - b1 = (t(3)**2*(y1%RootMxc - y2%RootMxc) + t(2)**2*(-y1%RootMxc + y3%RootMxc))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%RootMxc + t(3)*y2%RootMxc - t(2)*y3%RootMxc ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%RootMxc = y1%RootMxc + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - b0 = (t(3)**2*(y1%LSSTipMxa - y2%LSSTipMxa) + t(2)**2*(-y1%LSSTipMxa + y3%LSSTipMxa))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%LSSTipMxa + t(3)*y2%LSSTipMxa - t(2)*y3%LSSTipMxa ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%LSSTipMxa = y1%LSSTipMxa + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%LSSTipMya - y2%LSSTipMya) + t(2)**2*(-y1%LSSTipMya + y3%LSSTipMya))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%LSSTipMya + t(3)*y2%LSSTipMya - t(2)*y3%LSSTipMya ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%LSSTipMya = y1%LSSTipMya + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%LSSTipMza - y2%LSSTipMza) + t(2)**2*(-y1%LSSTipMza + y3%LSSTipMza))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%LSSTipMza + t(3)*y2%LSSTipMza - t(2)*y3%LSSTipMza ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%LSSTipMza = y1%LSSTipMza + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%LSSTipMys - y2%LSSTipMys) + t(2)**2*(-y1%LSSTipMys + y3%LSSTipMys))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%LSSTipMys + t(3)*y2%LSSTipMys - t(2)*y3%LSSTipMys ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%LSSTipMys = y1%LSSTipMys + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%LSSTipMzs - y2%LSSTipMzs) + t(2)**2*(-y1%LSSTipMzs + y3%LSSTipMzs))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%LSSTipMzs + t(3)*y2%LSSTipMzs - t(2)*y3%LSSTipMzs ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%LSSTipMzs = y1%LSSTipMzs + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%YawBrMyn - y2%YawBrMyn) + t(2)**2*(-y1%YawBrMyn + y3%YawBrMyn))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%YawBrMyn + t(3)*y2%YawBrMyn - t(2)*y3%YawBrMyn ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%YawBrMyn = y1%YawBrMyn + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%YawBrMzn - y2%YawBrMzn) + t(2)**2*(-y1%YawBrMzn + y3%YawBrMzn))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%YawBrMzn + t(3)*y2%YawBrMzn - t(2)*y3%YawBrMzn ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%YawBrMzn = y1%YawBrMzn + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%NcIMURAxs - y2%NcIMURAxs) + t(2)**2*(-y1%NcIMURAxs + y3%NcIMURAxs))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%NcIMURAxs + t(3)*y2%NcIMURAxs - t(2)*y3%NcIMURAxs ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%NcIMURAxs = y1%NcIMURAxs + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%NcIMURAys - y2%NcIMURAys) + t(2)**2*(-y1%NcIMURAys + y3%NcIMURAys))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%NcIMURAys + t(3)*y2%NcIMURAys - t(2)*y3%NcIMURAys ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%NcIMURAys = y1%NcIMURAys + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%NcIMURAzs - y2%NcIMURAzs) + t(2)**2*(-y1%NcIMURAzs + y3%NcIMURAzs))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%NcIMURAzs + t(3)*y2%NcIMURAzs - t(2)*y3%NcIMURAzs ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%NcIMURAzs = y1%NcIMURAzs + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%RotPwr - y2%RotPwr) + t(2)**2*(-y1%RotPwr + y3%RotPwr))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%RotPwr + t(3)*y2%RotPwr - t(2)*y3%RotPwr ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%RotPwr = y1%RotPwr + b0 * t_out + c0 * t_out**2 + CALL Angles_ExtrapInterp( y1%Yaw, y2%Yaw, y3%Yaw, tin, y_out%Yaw, tin_out ) + b = (t(3)**2*(y1%YawRate - y2%YawRate) + t(2)**2*(-y1%YawRate + y3%YawRate))* scaleFactor + c = ( (t(2)-t(3))*y1%YawRate + t(3)*y2%YawRate - t(2)*y3%YawRate ) * scaleFactor + y_out%YawRate = y1%YawRate + b + c * t_out + b = (t(3)**2*(y1%LSS_Spd - y2%LSS_Spd) + t(2)**2*(-y1%LSS_Spd + y3%LSS_Spd))* scaleFactor + c = ( (t(2)-t(3))*y1%LSS_Spd + t(3)*y2%LSS_Spd - t(2)*y3%LSS_Spd ) * scaleFactor + y_out%LSS_Spd = y1%LSS_Spd + b + c * t_out + b = (t(3)**2*(y1%HSS_Spd - y2%HSS_Spd) + t(2)**2*(-y1%HSS_Spd + y3%HSS_Spd))* scaleFactor + c = ( (t(2)-t(3))*y1%HSS_Spd + t(3)*y2%HSS_Spd - t(2)*y3%HSS_Spd ) * scaleFactor + y_out%HSS_Spd = y1%HSS_Spd + b + c * t_out + b = (t(3)**2*(y1%RotSpeed - y2%RotSpeed) + t(2)**2*(-y1%RotSpeed + y3%RotSpeed))* scaleFactor + c = ( (t(2)-t(3))*y1%RotSpeed + t(3)*y2%RotSpeed - t(2)*y3%RotSpeed ) * scaleFactor + y_out%RotSpeed = y1%RotSpeed + b + c * t_out + b = (t(3)**2*(y1%TwrAccel - y2%TwrAccel) + t(2)**2*(-y1%TwrAccel + y3%TwrAccel))* scaleFactor + c = ( (t(2)-t(3))*y1%TwrAccel + t(3)*y2%TwrAccel - t(2)*y3%TwrAccel ) * scaleFactor + y_out%TwrAccel = y1%TwrAccel + b + c * t_out + CALL Angles_ExtrapInterp( y1%YawAngle, y2%YawAngle, y3%YawAngle, tin, y_out%YawAngle, tin_out ) + DO i1 = LBOUND(y_out%RootMyc,1),UBOUND(y_out%RootMyc,1) + b = (t(3)**2*(y1%RootMyc(i1) - y2%RootMyc(i1)) + t(2)**2*(-y1%RootMyc(i1) + y3%RootMyc(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%RootMyc(i1) + t(3)*y2%RootMyc(i1) - t(2)*y3%RootMyc(i1) ) * scaleFactor + y_out%RootMyc(i1) = y1%RootMyc(i1) + b + c * t_out + END DO + b = (t(3)**2*(y1%YawBrTAxp - y2%YawBrTAxp) + t(2)**2*(-y1%YawBrTAxp + y3%YawBrTAxp))* scaleFactor + c = ( (t(2)-t(3))*y1%YawBrTAxp + t(3)*y2%YawBrTAxp - t(2)*y3%YawBrTAxp ) * scaleFactor + y_out%YawBrTAxp = y1%YawBrTAxp + b + c * t_out + b = (t(3)**2*(y1%YawBrTAyp - y2%YawBrTAyp) + t(2)**2*(-y1%YawBrTAyp + y3%YawBrTAyp))* scaleFactor + c = ( (t(2)-t(3))*y1%YawBrTAyp + t(3)*y2%YawBrTAyp - t(2)*y3%YawBrTAyp ) * scaleFactor + y_out%YawBrTAyp = y1%YawBrTAyp + b + c * t_out + CALL Angles_ExtrapInterp( y1%LSSTipPxa, y2%LSSTipPxa, y3%LSSTipPxa, tin, y_out%LSSTipPxa, tin_out ) + DO i1 = LBOUND(y_out%RootMxc,1),UBOUND(y_out%RootMxc,1) + b = (t(3)**2*(y1%RootMxc(i1) - y2%RootMxc(i1)) + t(2)**2*(-y1%RootMxc(i1) + y3%RootMxc(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%RootMxc(i1) + t(3)*y2%RootMxc(i1) - t(2)*y3%RootMxc(i1) ) * scaleFactor + y_out%RootMxc(i1) = y1%RootMxc(i1) + b + c * t_out + END DO + b = (t(3)**2*(y1%LSSTipMxa - y2%LSSTipMxa) + t(2)**2*(-y1%LSSTipMxa + y3%LSSTipMxa))* scaleFactor + c = ( (t(2)-t(3))*y1%LSSTipMxa + t(3)*y2%LSSTipMxa - t(2)*y3%LSSTipMxa ) * scaleFactor + y_out%LSSTipMxa = y1%LSSTipMxa + b + c * t_out + b = (t(3)**2*(y1%LSSTipMya - y2%LSSTipMya) + t(2)**2*(-y1%LSSTipMya + y3%LSSTipMya))* scaleFactor + c = ( (t(2)-t(3))*y1%LSSTipMya + t(3)*y2%LSSTipMya - t(2)*y3%LSSTipMya ) * scaleFactor + y_out%LSSTipMya = y1%LSSTipMya + b + c * t_out + b = (t(3)**2*(y1%LSSTipMza - y2%LSSTipMza) + t(2)**2*(-y1%LSSTipMza + y3%LSSTipMza))* scaleFactor + c = ( (t(2)-t(3))*y1%LSSTipMza + t(3)*y2%LSSTipMza - t(2)*y3%LSSTipMza ) * scaleFactor + y_out%LSSTipMza = y1%LSSTipMza + b + c * t_out + b = (t(3)**2*(y1%LSSTipMys - y2%LSSTipMys) + t(2)**2*(-y1%LSSTipMys + y3%LSSTipMys))* scaleFactor + c = ( (t(2)-t(3))*y1%LSSTipMys + t(3)*y2%LSSTipMys - t(2)*y3%LSSTipMys ) * scaleFactor + y_out%LSSTipMys = y1%LSSTipMys + b + c * t_out + b = (t(3)**2*(y1%LSSTipMzs - y2%LSSTipMzs) + t(2)**2*(-y1%LSSTipMzs + y3%LSSTipMzs))* scaleFactor + c = ( (t(2)-t(3))*y1%LSSTipMzs + t(3)*y2%LSSTipMzs - t(2)*y3%LSSTipMzs ) * scaleFactor + y_out%LSSTipMzs = y1%LSSTipMzs + b + c * t_out + b = (t(3)**2*(y1%YawBrMyn - y2%YawBrMyn) + t(2)**2*(-y1%YawBrMyn + y3%YawBrMyn))* scaleFactor + c = ( (t(2)-t(3))*y1%YawBrMyn + t(3)*y2%YawBrMyn - t(2)*y3%YawBrMyn ) * scaleFactor + y_out%YawBrMyn = y1%YawBrMyn + b + c * t_out + b = (t(3)**2*(y1%YawBrMzn - y2%YawBrMzn) + t(2)**2*(-y1%YawBrMzn + y3%YawBrMzn))* scaleFactor + c = ( (t(2)-t(3))*y1%YawBrMzn + t(3)*y2%YawBrMzn - t(2)*y3%YawBrMzn ) * scaleFactor + y_out%YawBrMzn = y1%YawBrMzn + b + c * t_out + b = (t(3)**2*(y1%NcIMURAxs - y2%NcIMURAxs) + t(2)**2*(-y1%NcIMURAxs + y3%NcIMURAxs))* scaleFactor + c = ( (t(2)-t(3))*y1%NcIMURAxs + t(3)*y2%NcIMURAxs - t(2)*y3%NcIMURAxs ) * scaleFactor + y_out%NcIMURAxs = y1%NcIMURAxs + b + c * t_out + b = (t(3)**2*(y1%NcIMURAys - y2%NcIMURAys) + t(2)**2*(-y1%NcIMURAys + y3%NcIMURAys))* scaleFactor + c = ( (t(2)-t(3))*y1%NcIMURAys + t(3)*y2%NcIMURAys - t(2)*y3%NcIMURAys ) * scaleFactor + y_out%NcIMURAys = y1%NcIMURAys + b + c * t_out + b = (t(3)**2*(y1%NcIMURAzs - y2%NcIMURAzs) + t(2)**2*(-y1%NcIMURAzs + y3%NcIMURAzs))* scaleFactor + c = ( (t(2)-t(3))*y1%NcIMURAzs + t(3)*y2%NcIMURAzs - t(2)*y3%NcIMURAzs ) * scaleFactor + y_out%NcIMURAzs = y1%NcIMURAzs + b + c * t_out + b = (t(3)**2*(y1%RotPwr - y2%RotPwr) + t(2)**2*(-y1%RotPwr + y3%RotPwr))* scaleFactor + c = ( (t(2)-t(3))*y1%RotPwr + t(3)*y2%RotPwr - t(2)*y3%RotPwr ) * scaleFactor + y_out%RotPwr = y1%RotPwr + b + c * t_out END SUBROUTINE ED_Output_ExtrapInterp2 END MODULE ElastoDyn_Types diff --git a/modules/extptfm/src/ExtPtfm_MCKF.f90 b/modules/extptfm/src/ExtPtfm_MCKF.f90 index e27fec588c..e5c32f0337 100644 --- a/modules/extptfm/src/ExtPtfm_MCKF.f90 +++ b/modules/extptfm/src/ExtPtfm_MCKF.f90 @@ -31,6 +31,7 @@ MODULE ExtPtfm_MCKF USE ExtPtfm_MCKF_Types USE ExtPtfm_MCKF_Parameters ! ID_*, N_INPUTS, N_OUTPUTS USE NWTC_Library + USE NWTC_LAPACK IMPLICIT NONE @@ -62,48 +63,7 @@ MODULE ExtPtfm_MCKF - INTERFACE LAPACK_COPY - SUBROUTINE DCOPY(N,DX,INCX,DY,INCY) - USE Precision, only: R8Ki - INTEGER :: INCX,INCY,N - real(R8Ki) :: DX(*),DY(*) - ENDSUBROUTINE - SUBROUTINE SCOPY(N,X,INCX,Y,INCY) - USE Precision, only: SiKi - INTEGER :: INCX,INCY,N - real(SiKi) :: X(*),Y(*) - ENDSUBROUTINE - END INTERFACE - INTERFACE LAPACK_GEMV - SUBROUTINE DGEMV(TRANS,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) - USE Precision, only: R8Ki - real(R8Ki) :: ALPHA,BETA - integer :: INCX,INCY,LDA,M,N - character :: TRANS - real(R8Ki) :: A(LDA,*),X(*),Y(*) - ENDSUBROUTINE - SUBROUTINE SGEMV(TRANS,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) - USE Precision, only: SiKi - real(SiKi) :: ALPHA,BETA - integer :: INCX,INCY,LDA,M,N - character :: TRANS - real(SiKi) :: A(LDA,*),X(*),Y(*) - ENDSUBROUTINE - END INTERFACE LAPACK_GEMV - INTERFACE LAPACK_AXPY - SUBROUTINE DAXPY(N,DA,DX,INCX,DY,INCY) - USE Precision, only: R8Ki - real(R8Ki) :: DA - integer :: INCX,INCY,N - real(R8Ki) :: DX(*),DY(*) - ENDSUBROUTINE - SUBROUTINE SAXPY(N,A,X,INCX,Y,INCY) - USE Precision, only: SiKi - real(SiKi) :: A - integer :: INCX,INCY,N - real(SiKi) :: X(*),Y(*) - ENDSUBROUTINE - END INTERFACE + CONTAINS !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ diff --git a/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 b/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 index 722545f71a..dcd7770cce 100644 --- a/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 +++ b/modules/extptfm/src/ExtPtfm_MCKF_Types.f90 @@ -253,18 +253,18 @@ SUBROUTINE ExtPtfm_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Linearize , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmRefzt - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(InData%InputFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%Linearize, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmRefzt + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE ExtPtfm_PackInitInput SUBROUTINE ExtPtfm_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -280,12 +280,6 @@ SUBROUTINE ExtPtfm_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -301,18 +295,18 @@ SUBROUTINE ExtPtfm_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%InputFile) - OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%Linearize = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmRefzt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%InputFile) + OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%Linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%Linearize) + Int_Xferred = Int_Xferred + 1 + OutData%PtfmRefzt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE ExtPtfm_UnPackInitInput SUBROUTINE ExtPtfm_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg ) @@ -509,22 +503,22 @@ SUBROUTINE ExtPtfm_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%IntMethod - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%FileFormat - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%RedFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%RedFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%RedFileCst) - IntKiBuf(Int_Xferred) = ICHAR(InData%RedFileCst(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%EquilStart , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%IntMethod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%FileFormat + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%RedFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%RedFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%RedFileCst) + IntKiBuf(Int_Xferred) = ICHAR(InData%RedFileCst(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%EquilStart, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%ActiveCBDOF) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -535,8 +529,10 @@ SUBROUTINE ExtPtfm_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ActiveCBDOF,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ActiveCBDOF)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%ActiveCBDOF))-1 ) = PACK(InData%ActiveCBDOF,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%ActiveCBDOF) + DO i1 = LBOUND(InData%ActiveCBDOF,1), UBOUND(InData%ActiveCBDOF,1) + IntKiBuf(Int_Xferred) = InData%ActiveCBDOF(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%InitPosList) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -548,8 +544,10 @@ SUBROUTINE ExtPtfm_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitPosList,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%InitPosList)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%InitPosList))-1 ) = PACK(InData%InitPosList,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%InitPosList) + DO i1 = LBOUND(InData%InitPosList,1), UBOUND(InData%InitPosList,1) + ReKiBuf(Re_Xferred) = InData%InitPosList(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%InitVelList) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -561,23 +559,25 @@ SUBROUTINE ExtPtfm_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InitVelList,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%InitVelList)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%InitVelList))-1 ) = PACK(InData%InitVelList,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%InitVelList) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%SumPrint , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%OutFile - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TabDelim , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%Tstart - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%InitVelList,1), UBOUND(InData%InitVelList,1) + ReKiBuf(Re_Xferred) = InData%InitVelList(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IntKiBuf(Int_Xferred) = TRANSFER(InData%SumPrint, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%OutFile + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TabDelim, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%OutFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DbKiBuf(Db_Xferred) = InData%Tstart + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%OutList) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -588,12 +588,12 @@ SUBROUTINE ExtPtfm_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutList,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) + DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) DO I = 1, LEN(InData%OutList) IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF END SUBROUTINE ExtPtfm_PackInputFile @@ -610,12 +610,6 @@ SUBROUTINE ExtPtfm_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -630,22 +624,22 @@ SUBROUTINE ExtPtfm_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%IntMethod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%FileFormat = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%RedFile) - OutData%RedFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%RedFileCst) - OutData%RedFileCst(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%EquilStart = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%IntMethod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%FileFormat = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%RedFile) + OutData%RedFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%RedFileCst) + OutData%RedFileCst(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%EquilStart = TRANSFER(IntKiBuf(Int_Xferred), OutData%EquilStart) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ActiveCBDOF not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -659,15 +653,10 @@ SUBROUTINE ExtPtfm_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ActiveCBDOF.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%ActiveCBDOF)>0) OutData%ActiveCBDOF = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%ActiveCBDOF))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%ActiveCBDOF) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%ActiveCBDOF,1), UBOUND(OutData%ActiveCBDOF,1) + OutData%ActiveCBDOF(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InitPosList not allocated Int_Xferred = Int_Xferred + 1 @@ -682,15 +671,10 @@ SUBROUTINE ExtPtfm_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitPosList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%InitPosList)>0) OutData%InitPosList = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%InitPosList))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%InitPosList) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%InitPosList,1), UBOUND(OutData%InitPosList,1) + OutData%InitPosList(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InitVelList not allocated Int_Xferred = Int_Xferred + 1 @@ -705,30 +689,25 @@ SUBROUTINE ExtPtfm_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InitVelList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%InitVelList)>0) OutData%InitVelList = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%InitVelList))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%InitVelList) - DEALLOCATE(mask1) - END IF - OutData%SumPrint = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%OutFile = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TabDelim = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutFmt) - OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%Tstart = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%InitVelList,1), UBOUND(OutData%InitVelList,1) + OutData%InitVelList(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%SumPrint = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumPrint) + Int_Xferred = Int_Xferred + 1 + OutData%OutFile = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TabDelim = TRANSFER(IntKiBuf(Int_Xferred), OutData%TabDelim) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%OutFmt) + OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%Tstart = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutList not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -742,19 +721,12 @@ SUBROUTINE ExtPtfm_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) + DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) DO I = 1, LEN(OutData%OutList) OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF END SUBROUTINE ExtPtfm_UnPackInputFile @@ -1088,12 +1060,12 @@ SUBROUTINE ExtPtfm_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1105,12 +1077,12 @@ SUBROUTINE ExtPtfm_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LinNames_y) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1122,12 +1094,12 @@ SUBROUTINE ExtPtfm_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_y,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%LinNames_y,1), UBOUND(InData%LinNames_y,1) + DO 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LinNames_x) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1139,12 +1111,12 @@ SUBROUTINE ExtPtfm_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_x,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%LinNames_x,1), UBOUND(InData%LinNames_x,1) + DO 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LinNames_u) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1156,12 +1128,12 @@ SUBROUTINE ExtPtfm_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_u,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%LinNames_u,1), UBOUND(InData%LinNames_u,1) + DO 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%RotFrame_y) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1173,8 +1145,10 @@ SUBROUTINE ExtPtfm_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_y,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RotFrame_y)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%RotFrame_y)-1 ) = TRANSFER(PACK( InData%RotFrame_y ,.TRUE.), IntKiBuf(1), SIZE(InData%RotFrame_y)) - Int_Xferred = Int_Xferred + SIZE(InData%RotFrame_y) + DO i1 = LBOUND(InData%RotFrame_y,1), UBOUND(InData%RotFrame_y,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_y(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%RotFrame_x) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1186,8 +1160,10 @@ SUBROUTINE ExtPtfm_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_x,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RotFrame_x)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%RotFrame_x)-1 ) = TRANSFER(PACK( InData%RotFrame_x ,.TRUE.), IntKiBuf(1), SIZE(InData%RotFrame_x)) - Int_Xferred = Int_Xferred + SIZE(InData%RotFrame_x) + 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 @@ -1199,8 +1175,10 @@ SUBROUTINE ExtPtfm_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_u,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RotFrame_u)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%RotFrame_u)-1 ) = TRANSFER(PACK( InData%RotFrame_u ,.TRUE.), IntKiBuf(1), SIZE(InData%RotFrame_u)) - Int_Xferred = Int_Xferred + SIZE(InData%RotFrame_u) + 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 @@ -1212,8 +1190,10 @@ SUBROUTINE ExtPtfm_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IsLoad_u,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%IsLoad_u)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%IsLoad_u)-1 ) = TRANSFER(PACK( InData%IsLoad_u ,.TRUE.), IntKiBuf(1), SIZE(InData%IsLoad_u)) - Int_Xferred = Int_Xferred + SIZE(InData%IsLoad_u) + DO i1 = LBOUND(InData%IsLoad_u,1), UBOUND(InData%IsLoad_u,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%IsLoad_u(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF END SUBROUTINE ExtPtfm_PackInitOutput @@ -1230,12 +1210,6 @@ SUBROUTINE ExtPtfm_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1303,19 +1277,12 @@ SUBROUTINE ExtPtfm_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated Int_Xferred = Int_Xferred + 1 @@ -1330,19 +1297,12 @@ SUBROUTINE ExtPtfm_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_y not allocated Int_Xferred = Int_Xferred + 1 @@ -1357,19 +1317,12 @@ SUBROUTINE ExtPtfm_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%LinNames_y,1), UBOUND(OutData%LinNames_y,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_x not allocated Int_Xferred = Int_Xferred + 1 @@ -1384,19 +1337,12 @@ SUBROUTINE ExtPtfm_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_x.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%LinNames_x,1), UBOUND(OutData%LinNames_x,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_u not allocated Int_Xferred = Int_Xferred + 1 @@ -1411,19 +1357,12 @@ SUBROUTINE ExtPtfm_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%LinNames_u,1), UBOUND(OutData%LinNames_u,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_y not allocated Int_Xferred = Int_Xferred + 1 @@ -1438,15 +1377,10 @@ SUBROUTINE ExtPtfm_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%RotFrame_y)>0) OutData%RotFrame_y = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%RotFrame_y))-1 ), OutData%RotFrame_y), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%RotFrame_y) - DEALLOCATE(mask1) + 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 @@ -1461,15 +1395,10 @@ SUBROUTINE ExtPtfm_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_x.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%RotFrame_x)>0) OutData%RotFrame_x = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%RotFrame_x))-1 ), OutData%RotFrame_x), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%RotFrame_x) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%RotFrame_x,1), UBOUND(OutData%RotFrame_x,1) + OutData%RotFrame_x(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_x(i1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_u not allocated Int_Xferred = Int_Xferred + 1 @@ -1484,15 +1413,10 @@ SUBROUTINE ExtPtfm_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%RotFrame_u)>0) OutData%RotFrame_u = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%RotFrame_u))-1 ), OutData%RotFrame_u), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%RotFrame_u) - DEALLOCATE(mask1) + 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 @@ -1507,15 +1431,10 @@ SUBROUTINE ExtPtfm_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%IsLoad_u)>0) OutData%IsLoad_u = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%IsLoad_u))-1 ), OutData%IsLoad_u), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%IsLoad_u) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%IsLoad_u,1), UBOUND(OutData%IsLoad_u,1) + OutData%IsLoad_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsLoad_u(i1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF END SUBROUTINE ExtPtfm_UnPackInitOutput @@ -1659,8 +1578,10 @@ SUBROUTINE ExtPtfm_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%qm,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%qm)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%qm))-1 ) = PACK(InData%qm,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%qm) + DO i1 = LBOUND(InData%qm,1), UBOUND(InData%qm,1) + ReKiBuf(Re_Xferred) = InData%qm(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%qmdot) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1672,8 +1593,10 @@ SUBROUTINE ExtPtfm_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%qmdot,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%qmdot)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%qmdot))-1 ) = PACK(InData%qmdot,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%qmdot) + DO i1 = LBOUND(InData%qmdot,1), UBOUND(InData%qmdot,1) + ReKiBuf(Re_Xferred) = InData%qmdot(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE ExtPtfm_PackContState @@ -1690,12 +1613,6 @@ SUBROUTINE ExtPtfm_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1723,15 +1640,10 @@ SUBROUTINE ExtPtfm_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%qm.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%qm)>0) OutData%qm = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%qm))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%qm) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%qm,1), UBOUND(OutData%qm,1) + OutData%qm(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! qmdot not allocated Int_Xferred = Int_Xferred + 1 @@ -1746,15 +1658,10 @@ SUBROUTINE ExtPtfm_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%qmdot.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%qmdot)>0) OutData%qmdot = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%qmdot))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%qmdot) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%qmdot,1), UBOUND(OutData%qmdot,1) + OutData%qmdot(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE ExtPtfm_UnPackContState @@ -1849,8 +1756,8 @@ SUBROUTINE ExtPtfm_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyDiscState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyDiscState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE ExtPtfm_PackDiscState SUBROUTINE ExtPtfm_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1866,12 +1773,6 @@ SUBROUTINE ExtPtfm_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_UnPackDiscState' @@ -1885,8 +1786,8 @@ SUBROUTINE ExtPtfm_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyDiscState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyDiscState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE ExtPtfm_UnPackDiscState SUBROUTINE ExtPtfm_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) @@ -1980,8 +1881,8 @@ SUBROUTINE ExtPtfm_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyConstrState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE ExtPtfm_PackConstrState SUBROUTINE ExtPtfm_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1997,12 +1898,6 @@ SUBROUTINE ExtPtfm_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_UnPackConstrState' @@ -2016,8 +1911,8 @@ SUBROUTINE ExtPtfm_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyConstrState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyConstrState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE ExtPtfm_UnPackConstrState SUBROUTINE ExtPtfm_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -2199,8 +2094,8 @@ SUBROUTINE ExtPtfm_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ENDIF END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%n - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%n + Int_Xferred = Int_Xferred + 1 END SUBROUTINE ExtPtfm_PackOtherState SUBROUTINE ExtPtfm_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2216,12 +2111,6 @@ SUBROUTINE ExtPtfm_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -2292,8 +2181,8 @@ SUBROUTINE ExtPtfm_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%n = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%n = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE ExtPtfm_UnPackOtherState SUBROUTINE ExtPtfm_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) @@ -2462,11 +2351,15 @@ SUBROUTINE ExtPtfm_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xFlat,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%xFlat)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%xFlat))-1 ) = PACK(InData%xFlat,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%xFlat) + DO i1 = LBOUND(InData%xFlat,1), UBOUND(InData%xFlat,1) + ReKiBuf(Re_Xferred) = InData%xFlat(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%uFlat))-1 ) = PACK(InData%uFlat,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%uFlat) + DO i1 = LBOUND(InData%uFlat,1), UBOUND(InData%uFlat,1) + ReKiBuf(Re_Xferred) = InData%uFlat(i1) + Re_Xferred = Re_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%F_at_t) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2477,13 +2370,15 @@ SUBROUTINE ExtPtfm_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_at_t,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%F_at_t)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F_at_t))-1 ) = PACK(InData%F_at_t,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F_at_t) + DO i1 = LBOUND(InData%F_at_t,1), UBOUND(InData%F_at_t,1) + ReKiBuf(Re_Xferred) = InData%F_at_t(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Indx - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%EquilStart , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Indx + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%EquilStart, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%AllOuts) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2494,8 +2389,10 @@ SUBROUTINE ExtPtfm_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AllOuts,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AllOuts)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AllOuts))-1 ) = PACK(InData%AllOuts,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AllOuts) + DO i1 = LBOUND(InData%AllOuts,1), UBOUND(InData%AllOuts,1) + ReKiBuf(Re_Xferred) = InData%AllOuts(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE ExtPtfm_PackMisc @@ -2512,12 +2409,6 @@ SUBROUTINE ExtPtfm_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -2545,27 +2436,17 @@ SUBROUTINE ExtPtfm_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xFlat.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%xFlat)>0) OutData%xFlat = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%xFlat))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%xFlat) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%xFlat,1), UBOUND(OutData%xFlat,1) + OutData%xFlat(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF i1_l = LBOUND(OutData%uFlat,1) i1_u = UBOUND(OutData%uFlat,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%uFlat = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%uFlat))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%uFlat) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%uFlat,1), UBOUND(OutData%uFlat,1) + OutData%uFlat(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_at_t not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -2579,20 +2460,15 @@ SUBROUTINE ExtPtfm_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_at_t.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%F_at_t)>0) OutData%F_at_t = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F_at_t))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F_at_t) - DEALLOCATE(mask1) - END IF - OutData%Indx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%EquilStart = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%F_at_t,1), UBOUND(OutData%F_at_t,1) + OutData%F_at_t(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%Indx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%EquilStart = TRANSFER(IntKiBuf(Int_Xferred), OutData%EquilStart) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AllOuts not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -2606,15 +2482,10 @@ SUBROUTINE ExtPtfm_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOuts.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%AllOuts)>0) OutData%AllOuts = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AllOuts))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AllOuts) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AllOuts,1), UBOUND(OutData%AllOuts,1) + OutData%AllOuts(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE ExtPtfm_UnPackMisc @@ -3280,8 +3151,12 @@ SUBROUTINE ExtPtfm_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Mass,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Mass)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Mass))-1 ) = PACK(InData%Mass,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Mass) + DO i2 = LBOUND(InData%Mass,2), UBOUND(InData%Mass,2) + DO i1 = LBOUND(InData%Mass,1), UBOUND(InData%Mass,1) + ReKiBuf(Re_Xferred) = InData%Mass(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Damp) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3296,8 +3171,12 @@ SUBROUTINE ExtPtfm_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Damp,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Damp)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Damp))-1 ) = PACK(InData%Damp,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Damp) + DO i2 = LBOUND(InData%Damp,2), UBOUND(InData%Damp,2) + DO i1 = LBOUND(InData%Damp,1), UBOUND(InData%Damp,1) + ReKiBuf(Re_Xferred) = InData%Damp(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Stff) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3312,8 +3191,12 @@ SUBROUTINE ExtPtfm_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Stff,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Stff)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Stff))-1 ) = PACK(InData%Stff,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Stff) + DO i2 = LBOUND(InData%Stff,2), UBOUND(InData%Stff,2) + DO i1 = LBOUND(InData%Stff,1), UBOUND(InData%Stff,1) + ReKiBuf(Re_Xferred) = InData%Stff(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Forces) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3328,8 +3211,12 @@ SUBROUTINE ExtPtfm_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Forces,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Forces)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Forces))-1 ) = PACK(InData%Forces,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Forces) + DO i2 = LBOUND(InData%Forces,2), UBOUND(InData%Forces,2) + DO i1 = LBOUND(InData%Forces,1), UBOUND(InData%Forces,1) + ReKiBuf(Re_Xferred) = InData%Forces(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%times) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3341,8 +3228,10 @@ SUBROUTINE ExtPtfm_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%times,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%times)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%times))-1 ) = PACK(InData%times,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%times) + DO i1 = LBOUND(InData%times,1), UBOUND(InData%times,1) + ReKiBuf(Re_Xferred) = InData%times(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%AMat) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3357,8 +3246,12 @@ SUBROUTINE ExtPtfm_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AMat,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AMat)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AMat))-1 ) = PACK(InData%AMat,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AMat) + DO i2 = LBOUND(InData%AMat,2), UBOUND(InData%AMat,2) + DO i1 = LBOUND(InData%AMat,1), UBOUND(InData%AMat,1) + ReKiBuf(Re_Xferred) = InData%AMat(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%BMat) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3373,8 +3266,12 @@ SUBROUTINE ExtPtfm_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BMat,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BMat)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BMat))-1 ) = PACK(InData%BMat,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BMat) + DO i2 = LBOUND(InData%BMat,2), UBOUND(InData%BMat,2) + DO i1 = LBOUND(InData%BMat,1), UBOUND(InData%BMat,1) + ReKiBuf(Re_Xferred) = InData%BMat(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%CMat) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3389,8 +3286,12 @@ SUBROUTINE ExtPtfm_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CMat,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CMat)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CMat))-1 ) = PACK(InData%CMat,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CMat) + DO i2 = LBOUND(InData%CMat,2), UBOUND(InData%CMat,2) + DO i1 = LBOUND(InData%CMat,1), UBOUND(InData%CMat,1) + ReKiBuf(Re_Xferred) = InData%CMat(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%DMat) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3405,8 +3306,12 @@ SUBROUTINE ExtPtfm_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DMat,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DMat)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%DMat))-1 ) = PACK(InData%DMat,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%DMat) + DO i2 = LBOUND(InData%DMat,2), UBOUND(InData%DMat,2) + DO i1 = LBOUND(InData%DMat,1), UBOUND(InData%DMat,1) + ReKiBuf(Re_Xferred) = InData%DMat(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%FX) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3418,8 +3323,10 @@ SUBROUTINE ExtPtfm_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FX,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FX)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FX))-1 ) = PACK(InData%FX,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FX) + DO i1 = LBOUND(InData%FX,1), UBOUND(InData%FX,1) + ReKiBuf(Re_Xferred) = InData%FX(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%FY) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3431,8 +3338,10 @@ SUBROUTINE ExtPtfm_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FY,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FY)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FY))-1 ) = PACK(InData%FY,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FY) + DO i1 = LBOUND(InData%FY,1), UBOUND(InData%FY,1) + ReKiBuf(Re_Xferred) = InData%FY(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%M11) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3447,8 +3356,12 @@ SUBROUTINE ExtPtfm_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M11,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%M11)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%M11))-1 ) = PACK(InData%M11,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%M11) + DO i2 = LBOUND(InData%M11,2), UBOUND(InData%M11,2) + DO i1 = LBOUND(InData%M11,1), UBOUND(InData%M11,1) + ReKiBuf(Re_Xferred) = InData%M11(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%M12) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3463,8 +3376,12 @@ SUBROUTINE ExtPtfm_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M12,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%M12)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%M12))-1 ) = PACK(InData%M12,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%M12) + DO i2 = LBOUND(InData%M12,2), UBOUND(InData%M12,2) + DO i1 = LBOUND(InData%M12,1), UBOUND(InData%M12,1) + ReKiBuf(Re_Xferred) = InData%M12(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%M22) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3479,8 +3396,12 @@ SUBROUTINE ExtPtfm_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M22,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%M22)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%M22))-1 ) = PACK(InData%M22,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%M22) + DO i2 = LBOUND(InData%M22,2), UBOUND(InData%M22,2) + DO i1 = LBOUND(InData%M22,1), UBOUND(InData%M22,1) + ReKiBuf(Re_Xferred) = InData%M22(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%M21) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3495,8 +3416,12 @@ SUBROUTINE ExtPtfm_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M21,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%M21)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%M21))-1 ) = PACK(InData%M21,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%M21) + DO i2 = LBOUND(InData%M21,2), UBOUND(InData%M21,2) + DO i1 = LBOUND(InData%M21,1), UBOUND(InData%M21,1) + ReKiBuf(Re_Xferred) = InData%M21(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%K11) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3511,8 +3436,12 @@ SUBROUTINE ExtPtfm_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%K11,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%K11)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%K11))-1 ) = PACK(InData%K11,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%K11) + DO i2 = LBOUND(InData%K11,2), UBOUND(InData%K11,2) + DO i1 = LBOUND(InData%K11,1), UBOUND(InData%K11,1) + ReKiBuf(Re_Xferred) = InData%K11(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%K22) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3527,8 +3456,12 @@ SUBROUTINE ExtPtfm_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%K22,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%K22)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%K22))-1 ) = PACK(InData%K22,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%K22) + DO i2 = LBOUND(InData%K22,2), UBOUND(InData%K22,2) + DO i1 = LBOUND(InData%K22,1), UBOUND(InData%K22,1) + ReKiBuf(Re_Xferred) = InData%K22(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%C11) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3543,8 +3476,12 @@ SUBROUTINE ExtPtfm_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C11,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%C11)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%C11))-1 ) = PACK(InData%C11,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%C11) + DO i2 = LBOUND(InData%C11,2), UBOUND(InData%C11,2) + DO i1 = LBOUND(InData%C11,1), UBOUND(InData%C11,1) + ReKiBuf(Re_Xferred) = InData%C11(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%C12) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3559,8 +3496,12 @@ SUBROUTINE ExtPtfm_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C12,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%C12)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%C12))-1 ) = PACK(InData%C12,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%C12) + DO i2 = LBOUND(InData%C12,2), UBOUND(InData%C12,2) + DO i1 = LBOUND(InData%C12,1), UBOUND(InData%C12,1) + ReKiBuf(Re_Xferred) = InData%C12(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%C22) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3575,8 +3516,12 @@ SUBROUTINE ExtPtfm_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C22,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%C22)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%C22))-1 ) = PACK(InData%C22,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%C22) + DO i2 = LBOUND(InData%C22,2), UBOUND(InData%C22,2) + DO i1 = LBOUND(InData%C22,1), UBOUND(InData%C22,1) + ReKiBuf(Re_Xferred) = InData%C22(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%C21) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3591,23 +3536,27 @@ SUBROUTINE ExtPtfm_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C21,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%C21)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%C21))-1 ) = PACK(InData%C21,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%C21) - END IF - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%EP_DeltaT - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%nTimeSteps - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%nCB - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%nCBFull - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%nTot - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%IntMethod - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(InData%C21,2), UBOUND(InData%C21,2) + DO i1 = LBOUND(InData%C21,1), UBOUND(InData%C21,1) + ReKiBuf(Re_Xferred) = InData%C21(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + DbKiBuf(Db_Xferred) = InData%EP_DeltaT + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nTimeSteps + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nCB + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nCBFull + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nTot + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%IntMethod + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%ActiveCBDOF) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -3618,8 +3567,10 @@ SUBROUTINE ExtPtfm_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ActiveCBDOF,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ActiveCBDOF)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%ActiveCBDOF))-1 ) = PACK(InData%ActiveCBDOF,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%ActiveCBDOF) + DO i1 = LBOUND(InData%ActiveCBDOF,1), UBOUND(InData%ActiveCBDOF,1) + IntKiBuf(Int_Xferred) = InData%ActiveCBDOF(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%OutParam) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3675,8 +3626,12 @@ SUBROUTINE ExtPtfm_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutParamLinIndx,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%OutParamLinIndx)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%OutParamLinIndx))-1 ) = PACK(InData%OutParamLinIndx,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%OutParamLinIndx) + DO i2 = LBOUND(InData%OutParamLinIndx,2), UBOUND(InData%OutParamLinIndx,2) + DO i1 = LBOUND(InData%OutParamLinIndx,1), UBOUND(InData%OutParamLinIndx,1) + IntKiBuf(Int_Xferred) = InData%OutParamLinIndx(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF END SUBROUTINE ExtPtfm_PackParam @@ -3693,12 +3648,6 @@ SUBROUTINE ExtPtfm_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -3730,15 +3679,12 @@ SUBROUTINE ExtPtfm_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Mass.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Mass)>0) OutData%Mass = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Mass))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Mass) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Mass,2), UBOUND(OutData%Mass,2) + DO i1 = LBOUND(OutData%Mass,1), UBOUND(OutData%Mass,1) + OutData%Mass(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Damp not allocated Int_Xferred = Int_Xferred + 1 @@ -3756,15 +3702,12 @@ SUBROUTINE ExtPtfm_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Damp.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Damp)>0) OutData%Damp = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Damp))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Damp) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Damp,2), UBOUND(OutData%Damp,2) + DO i1 = LBOUND(OutData%Damp,1), UBOUND(OutData%Damp,1) + OutData%Damp(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Stff not allocated Int_Xferred = Int_Xferred + 1 @@ -3782,15 +3725,12 @@ SUBROUTINE ExtPtfm_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Stff.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Stff)>0) OutData%Stff = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Stff))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Stff) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Stff,2), UBOUND(OutData%Stff,2) + DO i1 = LBOUND(OutData%Stff,1), UBOUND(OutData%Stff,1) + OutData%Stff(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Forces not allocated Int_Xferred = Int_Xferred + 1 @@ -3808,15 +3748,12 @@ SUBROUTINE ExtPtfm_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Forces.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Forces)>0) OutData%Forces = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Forces))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Forces) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Forces,2), UBOUND(OutData%Forces,2) + DO i1 = LBOUND(OutData%Forces,1), UBOUND(OutData%Forces,1) + OutData%Forces(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! times not allocated Int_Xferred = Int_Xferred + 1 @@ -3831,15 +3768,10 @@ SUBROUTINE ExtPtfm_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%times.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%times)>0) OutData%times = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%times))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%times) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%times,1), UBOUND(OutData%times,1) + OutData%times(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AMat not allocated Int_Xferred = Int_Xferred + 1 @@ -3857,15 +3789,12 @@ SUBROUTINE ExtPtfm_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AMat.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%AMat)>0) OutData%AMat = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AMat))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AMat) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AMat,2), UBOUND(OutData%AMat,2) + DO i1 = LBOUND(OutData%AMat,1), UBOUND(OutData%AMat,1) + OutData%AMat(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BMat not allocated Int_Xferred = Int_Xferred + 1 @@ -3883,15 +3812,12 @@ SUBROUTINE ExtPtfm_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BMat.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%BMat)>0) OutData%BMat = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BMat))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BMat) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%BMat,2), UBOUND(OutData%BMat,2) + DO i1 = LBOUND(OutData%BMat,1), UBOUND(OutData%BMat,1) + OutData%BMat(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CMat not allocated Int_Xferred = Int_Xferred + 1 @@ -3909,15 +3835,12 @@ SUBROUTINE ExtPtfm_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CMat.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%CMat)>0) OutData%CMat = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CMat))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CMat) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%CMat,2), UBOUND(OutData%CMat,2) + DO i1 = LBOUND(OutData%CMat,1), UBOUND(OutData%CMat,1) + OutData%CMat(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DMat not allocated Int_Xferred = Int_Xferred + 1 @@ -3935,15 +3858,12 @@ SUBROUTINE ExtPtfm_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DMat.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%DMat)>0) OutData%DMat = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%DMat))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%DMat) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%DMat,2), UBOUND(OutData%DMat,2) + DO i1 = LBOUND(OutData%DMat,1), UBOUND(OutData%DMat,1) + OutData%DMat(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FX not allocated Int_Xferred = Int_Xferred + 1 @@ -3958,15 +3878,10 @@ SUBROUTINE ExtPtfm_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FX.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%FX)>0) OutData%FX = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FX))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FX) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FX,1), UBOUND(OutData%FX,1) + OutData%FX(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FY not allocated Int_Xferred = Int_Xferred + 1 @@ -3981,15 +3896,10 @@ SUBROUTINE ExtPtfm_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FY.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%FY)>0) OutData%FY = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FY))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FY) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FY,1), UBOUND(OutData%FY,1) + OutData%FY(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! M11 not allocated Int_Xferred = Int_Xferred + 1 @@ -4007,15 +3917,12 @@ SUBROUTINE ExtPtfm_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%M11.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%M11)>0) OutData%M11 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%M11))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%M11) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%M11,2), UBOUND(OutData%M11,2) + DO i1 = LBOUND(OutData%M11,1), UBOUND(OutData%M11,1) + OutData%M11(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! M12 not allocated Int_Xferred = Int_Xferred + 1 @@ -4033,15 +3940,12 @@ SUBROUTINE ExtPtfm_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%M12.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%M12)>0) OutData%M12 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%M12))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%M12) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%M12,2), UBOUND(OutData%M12,2) + DO i1 = LBOUND(OutData%M12,1), UBOUND(OutData%M12,1) + OutData%M12(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! M22 not allocated Int_Xferred = Int_Xferred + 1 @@ -4059,15 +3963,12 @@ SUBROUTINE ExtPtfm_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%M22.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%M22)>0) OutData%M22 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%M22))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%M22) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%M22,2), UBOUND(OutData%M22,2) + DO i1 = LBOUND(OutData%M22,1), UBOUND(OutData%M22,1) + OutData%M22(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! M21 not allocated Int_Xferred = Int_Xferred + 1 @@ -4085,15 +3986,12 @@ SUBROUTINE ExtPtfm_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%M21.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%M21)>0) OutData%M21 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%M21))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%M21) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%M21,2), UBOUND(OutData%M21,2) + DO i1 = LBOUND(OutData%M21,1), UBOUND(OutData%M21,1) + OutData%M21(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! K11 not allocated Int_Xferred = Int_Xferred + 1 @@ -4111,15 +4009,12 @@ SUBROUTINE ExtPtfm_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%K11.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%K11)>0) OutData%K11 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%K11))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%K11) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%K11,2), UBOUND(OutData%K11,2) + DO i1 = LBOUND(OutData%K11,1), UBOUND(OutData%K11,1) + OutData%K11(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! K22 not allocated Int_Xferred = Int_Xferred + 1 @@ -4137,15 +4032,12 @@ SUBROUTINE ExtPtfm_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%K22.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%K22)>0) OutData%K22 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%K22))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%K22) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%K22,2), UBOUND(OutData%K22,2) + DO i1 = LBOUND(OutData%K22,1), UBOUND(OutData%K22,1) + OutData%K22(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C11 not allocated Int_Xferred = Int_Xferred + 1 @@ -4163,15 +4055,12 @@ SUBROUTINE ExtPtfm_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C11.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%C11)>0) OutData%C11 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%C11))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%C11) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%C11,2), UBOUND(OutData%C11,2) + DO i1 = LBOUND(OutData%C11,1), UBOUND(OutData%C11,1) + OutData%C11(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C12 not allocated Int_Xferred = Int_Xferred + 1 @@ -4189,15 +4078,12 @@ SUBROUTINE ExtPtfm_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C12.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%C12)>0) OutData%C12 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%C12))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%C12) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%C12,2), UBOUND(OutData%C12,2) + DO i1 = LBOUND(OutData%C12,1), UBOUND(OutData%C12,1) + OutData%C12(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C22 not allocated Int_Xferred = Int_Xferred + 1 @@ -4215,15 +4101,12 @@ SUBROUTINE ExtPtfm_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C22.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%C22)>0) OutData%C22 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%C22))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%C22) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%C22,2), UBOUND(OutData%C22,2) + DO i1 = LBOUND(OutData%C22,1), UBOUND(OutData%C22,1) + OutData%C22(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C21 not allocated Int_Xferred = Int_Xferred + 1 @@ -4241,30 +4124,27 @@ SUBROUTINE ExtPtfm_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C21.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%C21)>0) OutData%C21 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%C21))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%C21) - DEALLOCATE(mask2) - END IF - OutData%EP_DeltaT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%nTimeSteps = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%nCB = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%nCBFull = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%nTot = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%IntMethod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(OutData%C21,2), UBOUND(OutData%C21,2) + DO i1 = LBOUND(OutData%C21,1), UBOUND(OutData%C21,1) + OutData%C21(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%EP_DeltaT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%nTimeSteps = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nCB = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nCBFull = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nTot = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%IntMethod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ActiveCBDOF not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -4278,15 +4158,10 @@ SUBROUTINE ExtPtfm_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ActiveCBDOF.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%ActiveCBDOF)>0) OutData%ActiveCBDOF = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%ActiveCBDOF))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%ActiveCBDOF) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%ActiveCBDOF,1), UBOUND(OutData%ActiveCBDOF,1) + OutData%ActiveCBDOF(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParam not allocated Int_Xferred = Int_Xferred + 1 @@ -4360,15 +4235,12 @@ SUBROUTINE ExtPtfm_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParamLinIndx.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%OutParamLinIndx)>0) OutData%OutParamLinIndx = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%OutParamLinIndx))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%OutParamLinIndx) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%OutParamLinIndx,2), UBOUND(OutData%OutParamLinIndx,2) + DO i1 = LBOUND(OutData%OutParamLinIndx,1), UBOUND(OutData%OutParamLinIndx,1) + OutData%OutParamLinIndx(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF END SUBROUTINE ExtPtfm_UnPackParam @@ -4526,12 +4398,6 @@ SUBROUTINE ExtPtfm_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_UnPackInput' @@ -4757,8 +4623,10 @@ SUBROUTINE ExtPtfm_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WriteOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WriteOutput))-1 ) = PACK(InData%WriteOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WriteOutput) + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE ExtPtfm_PackOutput @@ -4775,12 +4643,6 @@ SUBROUTINE ExtPtfm_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -4848,15 +4710,10 @@ SUBROUTINE ExtPtfm_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WriteOutput)>0) OutData%WriteOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WriteOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WriteOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE ExtPtfm_UnPackOutput @@ -4935,8 +4792,8 @@ SUBROUTINE ExtPtfm_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, Err REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -4951,6 +4808,8 @@ SUBROUTINE ExtPtfm_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(u1%PtfmMesh, u2%PtfmMesh, tin, u_out%PtfmMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE ExtPtfm_Input_ExtrapInterp1 @@ -4982,8 +4841,9 @@ SUBROUTINE ExtPtfm_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_Input_ExtrapInterp2' @@ -5005,6 +4865,8 @@ SUBROUTINE ExtPtfm_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(u1%PtfmMesh, u2%PtfmMesh, u3%PtfmMesh, tin, u_out%PtfmMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE ExtPtfm_Input_ExtrapInterp2 @@ -5084,12 +4946,12 @@ SUBROUTINE ExtPtfm_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, Er REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -5102,15 +4964,15 @@ SUBROUTINE ExtPtfm_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(y1%PtfmMesh, y2%PtfmMesh, tin, y_out%PtfmMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = -(y1%WriteOutput - y2%WriteOutput)/t(2) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO END IF ! check if allocated END SUBROUTINE ExtPtfm_Output_ExtrapInterp1 @@ -5141,13 +5003,14 @@ SUBROUTINE ExtPtfm_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'ExtPtfm_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -5166,16 +5029,16 @@ SUBROUTINE ExtPtfm_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(y1%PtfmMesh, y2%PtfmMesh, y3%PtfmMesh, tin, y_out%PtfmMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = (t(3)**2*(y1%WriteOutput - y2%WriteOutput) + t(2)**2*(-y1%WriteOutput + y3%WriteOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WriteOutput + t(3)*y2%WriteOutput - t(2)*y3%WriteOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO END IF ! check if allocated END SUBROUTINE ExtPtfm_Output_ExtrapInterp2 diff --git a/modules/feamooring/src/FEAMooring_Types.f90 b/modules/feamooring/src/FEAMooring_Types.f90 index bb2571c873..ffed532365 100644 --- a/modules/feamooring/src/FEAMooring_Types.f90 +++ b/modules/feamooring/src/FEAMooring_Types.f90 @@ -713,8 +713,8 @@ SUBROUTINE FEAM_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 IF ( .NOT. ALLOCATED(InData%LineCI) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -725,8 +725,10 @@ SUBROUTINE FEAM_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LineCI,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LineCI)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LineCI))-1 ) = PACK(InData%LineCI,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LineCI) + DO i1 = LBOUND(InData%LineCI,1), UBOUND(InData%LineCI,1) + ReKiBuf(Re_Xferred) = InData%LineCI(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LineCD) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -738,8 +740,10 @@ SUBROUTINE FEAM_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LineCD,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LineCD)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LineCD))-1 ) = PACK(InData%LineCD,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LineCD) + DO i1 = LBOUND(InData%LineCD,1), UBOUND(InData%LineCD,1) + ReKiBuf(Re_Xferred) = InData%LineCD(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LEAStiff) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -751,8 +755,10 @@ SUBROUTINE FEAM_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LEAStiff,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LEAStiff)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LEAStiff))-1 ) = PACK(InData%LEAStiff,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LEAStiff) + DO i1 = LBOUND(InData%LEAStiff,1), UBOUND(InData%LEAStiff,1) + ReKiBuf(Re_Xferred) = InData%LEAStiff(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LMassDen) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -764,8 +770,10 @@ SUBROUTINE FEAM_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LMassDen,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LMassDen)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LMassDen))-1 ) = PACK(InData%LMassDen,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LMassDen) + DO i1 = LBOUND(InData%LMassDen,1), UBOUND(InData%LMassDen,1) + ReKiBuf(Re_Xferred) = InData%LMassDen(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LDMassDen) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -777,8 +785,10 @@ SUBROUTINE FEAM_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LDMassDen,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LDMassDen)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LDMassDen))-1 ) = PACK(InData%LDMassDen,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LDMassDen) + DO i1 = LBOUND(InData%LDMassDen,1), UBOUND(InData%LDMassDen,1) + ReKiBuf(Re_Xferred) = InData%LDMassDen(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%BottmStiff) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -790,8 +800,10 @@ SUBROUTINE FEAM_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BottmStiff,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BottmStiff)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BottmStiff))-1 ) = PACK(InData%BottmStiff,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BottmStiff) + DO i1 = LBOUND(InData%BottmStiff,1), UBOUND(InData%BottmStiff,1) + ReKiBuf(Re_Xferred) = InData%BottmStiff(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LRadAnch) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -803,8 +815,10 @@ SUBROUTINE FEAM_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LRadAnch,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LRadAnch)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LRadAnch))-1 ) = PACK(InData%LRadAnch,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LRadAnch) + DO i1 = LBOUND(InData%LRadAnch,1), UBOUND(InData%LRadAnch,1) + ReKiBuf(Re_Xferred) = InData%LRadAnch(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LAngAnch) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -816,8 +830,10 @@ SUBROUTINE FEAM_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LAngAnch,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LAngAnch)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LAngAnch))-1 ) = PACK(InData%LAngAnch,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LAngAnch) + DO i1 = LBOUND(InData%LAngAnch,1), UBOUND(InData%LAngAnch,1) + ReKiBuf(Re_Xferred) = InData%LAngAnch(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LDpthAnch) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -829,8 +845,10 @@ SUBROUTINE FEAM_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LDpthAnch,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LDpthAnch)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LDpthAnch))-1 ) = PACK(InData%LDpthAnch,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LDpthAnch) + DO i1 = LBOUND(InData%LDpthAnch,1), UBOUND(InData%LDpthAnch,1) + ReKiBuf(Re_Xferred) = InData%LDpthAnch(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LRadFair) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -842,8 +860,10 @@ SUBROUTINE FEAM_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LRadFair,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LRadFair)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LRadFair))-1 ) = PACK(InData%LRadFair,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LRadFair) + DO i1 = LBOUND(InData%LRadFair,1), UBOUND(InData%LRadFair,1) + ReKiBuf(Re_Xferred) = InData%LRadFair(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LAngFair) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -855,8 +875,10 @@ SUBROUTINE FEAM_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LAngFair,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LAngFair)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LAngFair))-1 ) = PACK(InData%LAngFair,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LAngFair) + DO i1 = LBOUND(InData%LAngFair,1), UBOUND(InData%LAngFair,1) + ReKiBuf(Re_Xferred) = InData%LAngFair(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LDrftFair) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -868,8 +890,10 @@ SUBROUTINE FEAM_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LDrftFair,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LDrftFair)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LDrftFair))-1 ) = PACK(InData%LDrftFair,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LDrftFair) + DO i1 = LBOUND(InData%LDrftFair,1), UBOUND(InData%LDrftFair,1) + ReKiBuf(Re_Xferred) = InData%LDrftFair(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LUnstrLen) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -881,8 +905,10 @@ SUBROUTINE FEAM_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LUnstrLen,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LUnstrLen)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LUnstrLen))-1 ) = PACK(InData%LUnstrLen,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LUnstrLen) + DO i1 = LBOUND(InData%LUnstrLen,1), UBOUND(InData%LUnstrLen,1) + ReKiBuf(Re_Xferred) = InData%LUnstrLen(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%Tension) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -894,8 +920,10 @@ SUBROUTINE FEAM_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Tension,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Tension)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Tension))-1 ) = PACK(InData%Tension,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Tension) + DO i1 = LBOUND(InData%Tension,1), UBOUND(InData%Tension,1) + ReKiBuf(Re_Xferred) = InData%Tension(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%GSL) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -913,8 +941,14 @@ SUBROUTINE FEAM_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GSL,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%GSL)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GSL))-1 ) = PACK(InData%GSL,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GSL) + DO i3 = LBOUND(InData%GSL,3), UBOUND(InData%GSL,3) + DO i2 = LBOUND(InData%GSL,2), UBOUND(InData%GSL,2) + DO i1 = LBOUND(InData%GSL,1), UBOUND(InData%GSL,1) + ReKiBuf(Re_Xferred) = InData%GSL(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%GSR) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -929,8 +963,12 @@ SUBROUTINE FEAM_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GSR,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%GSR)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GSR))-1 ) = PACK(InData%GSR,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GSR) + DO i2 = LBOUND(InData%GSR,2), UBOUND(InData%GSR,2) + DO i1 = LBOUND(InData%GSR,1), UBOUND(InData%GSR,1) + ReKiBuf(Re_Xferred) = InData%GSR(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%GE) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -948,35 +986,41 @@ SUBROUTINE FEAM_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GE,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%GE)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GE))-1 ) = PACK(InData%GE,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GE) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumLines - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumElems - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Eps - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WtrDens - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MaxIter - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%SumPrint , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%OutFile - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TabDelim , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%Tstart - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 + DO i3 = LBOUND(InData%GE,3), UBOUND(InData%GE,3) + DO i2 = LBOUND(InData%GE,2), UBOUND(InData%GE,2) + DO i1 = LBOUND(InData%GE,1), UBOUND(InData%GE,1) + ReKiBuf(Re_Xferred) = InData%GE(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IntKiBuf(Int_Xferred) = InData%NumLines + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumElems + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Eps + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Gravity + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDens + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MaxIter + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%SumPrint, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%OutFile + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TabDelim, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%OutFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DbKiBuf(Db_Xferred) = InData%Tstart + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%OutList) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -987,12 +1031,12 @@ SUBROUTINE FEAM_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutList,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) + DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) DO I = 1, LEN(InData%OutList) IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF END SUBROUTINE FEAM_PackInputFile @@ -1009,12 +1053,6 @@ SUBROUTINE FEAM_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (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 @@ -1032,8 +1070,8 @@ SUBROUTINE FEAM_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LineCI not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1047,15 +1085,10 @@ SUBROUTINE FEAM_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineCI.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LineCI)>0) OutData%LineCI = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LineCI))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LineCI) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LineCI,1), UBOUND(OutData%LineCI,1) + OutData%LineCI(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LineCD not allocated Int_Xferred = Int_Xferred + 1 @@ -1070,15 +1103,10 @@ SUBROUTINE FEAM_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineCD.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LineCD)>0) OutData%LineCD = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LineCD))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LineCD) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LineCD,1), UBOUND(OutData%LineCD,1) + OutData%LineCD(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LEAStiff not allocated Int_Xferred = Int_Xferred + 1 @@ -1093,15 +1121,10 @@ SUBROUTINE FEAM_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LEAStiff.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LEAStiff)>0) OutData%LEAStiff = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LEAStiff))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LEAStiff) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LEAStiff,1), UBOUND(OutData%LEAStiff,1) + OutData%LEAStiff(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LMassDen not allocated Int_Xferred = Int_Xferred + 1 @@ -1116,15 +1139,10 @@ SUBROUTINE FEAM_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LMassDen.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LMassDen)>0) OutData%LMassDen = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LMassDen))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LMassDen) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LMassDen,1), UBOUND(OutData%LMassDen,1) + OutData%LMassDen(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LDMassDen not allocated Int_Xferred = Int_Xferred + 1 @@ -1139,15 +1157,10 @@ SUBROUTINE FEAM_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LDMassDen.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LDMassDen)>0) OutData%LDMassDen = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LDMassDen))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LDMassDen) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LDMassDen,1), UBOUND(OutData%LDMassDen,1) + OutData%LDMassDen(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BottmStiff not allocated Int_Xferred = Int_Xferred + 1 @@ -1162,15 +1175,10 @@ SUBROUTINE FEAM_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BottmStiff.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BottmStiff)>0) OutData%BottmStiff = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BottmStiff))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BottmStiff) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BottmStiff,1), UBOUND(OutData%BottmStiff,1) + OutData%BottmStiff(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LRadAnch not allocated Int_Xferred = Int_Xferred + 1 @@ -1185,15 +1193,10 @@ SUBROUTINE FEAM_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LRadAnch.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LRadAnch)>0) OutData%LRadAnch = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LRadAnch))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LRadAnch) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LRadAnch,1), UBOUND(OutData%LRadAnch,1) + OutData%LRadAnch(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LAngAnch not allocated Int_Xferred = Int_Xferred + 1 @@ -1208,15 +1211,10 @@ SUBROUTINE FEAM_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LAngAnch.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LAngAnch)>0) OutData%LAngAnch = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LAngAnch))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LAngAnch) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LAngAnch,1), UBOUND(OutData%LAngAnch,1) + OutData%LAngAnch(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LDpthAnch not allocated Int_Xferred = Int_Xferred + 1 @@ -1231,15 +1229,10 @@ SUBROUTINE FEAM_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LDpthAnch.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LDpthAnch)>0) OutData%LDpthAnch = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LDpthAnch))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LDpthAnch) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LDpthAnch,1), UBOUND(OutData%LDpthAnch,1) + OutData%LDpthAnch(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LRadFair not allocated Int_Xferred = Int_Xferred + 1 @@ -1254,15 +1247,10 @@ SUBROUTINE FEAM_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LRadFair.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LRadFair)>0) OutData%LRadFair = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LRadFair))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LRadFair) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LRadFair,1), UBOUND(OutData%LRadFair,1) + OutData%LRadFair(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LAngFair not allocated Int_Xferred = Int_Xferred + 1 @@ -1277,15 +1265,10 @@ SUBROUTINE FEAM_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LAngFair.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LAngFair)>0) OutData%LAngFair = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LAngFair))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LAngFair) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LAngFair,1), UBOUND(OutData%LAngFair,1) + OutData%LAngFair(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LDrftFair not allocated Int_Xferred = Int_Xferred + 1 @@ -1300,15 +1283,10 @@ SUBROUTINE FEAM_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LDrftFair.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LDrftFair)>0) OutData%LDrftFair = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LDrftFair))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LDrftFair) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LDrftFair,1), UBOUND(OutData%LDrftFair,1) + OutData%LDrftFair(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LUnstrLen not allocated Int_Xferred = Int_Xferred + 1 @@ -1323,15 +1301,10 @@ SUBROUTINE FEAM_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LUnstrLen.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LUnstrLen)>0) OutData%LUnstrLen = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LUnstrLen))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LUnstrLen) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LUnstrLen,1), UBOUND(OutData%LUnstrLen,1) + OutData%LUnstrLen(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Tension not allocated Int_Xferred = Int_Xferred + 1 @@ -1346,15 +1319,10 @@ SUBROUTINE FEAM_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Tension.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Tension)>0) OutData%Tension = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Tension))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Tension) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Tension,1), UBOUND(OutData%Tension,1) + OutData%Tension(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GSL not allocated Int_Xferred = Int_Xferred + 1 @@ -1375,15 +1343,14 @@ SUBROUTINE FEAM_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GSL.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%GSL)>0) OutData%GSL = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GSL))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GSL) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%GSL,3), UBOUND(OutData%GSL,3) + DO i2 = LBOUND(OutData%GSL,2), UBOUND(OutData%GSL,2) + DO i1 = LBOUND(OutData%GSL,1), UBOUND(OutData%GSL,1) + OutData%GSL(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GSR not allocated Int_Xferred = Int_Xferred + 1 @@ -1401,15 +1368,12 @@ SUBROUTINE FEAM_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GSR.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%GSR)>0) OutData%GSR = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GSR))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GSR) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%GSR,2), UBOUND(OutData%GSR,2) + DO i1 = LBOUND(OutData%GSR,1), UBOUND(OutData%GSR,1) + OutData%GSR(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GE not allocated Int_Xferred = Int_Xferred + 1 @@ -1430,42 +1394,41 @@ SUBROUTINE FEAM_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%GE)>0) OutData%GE = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GE))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GE) - DEALLOCATE(mask3) - END IF - OutData%NumLines = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumElems = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%Eps = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Gravity = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MaxIter = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%SumPrint = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%OutFile = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TabDelim = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutFmt) - OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%Tstart = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i3 = LBOUND(OutData%GE,3), UBOUND(OutData%GE,3) + DO i2 = LBOUND(OutData%GE,2), UBOUND(OutData%GE,2) + DO i1 = LBOUND(OutData%GE,1), UBOUND(OutData%GE,1) + OutData%GE(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + OutData%NumLines = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumElems = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%Eps = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Gravity = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WtrDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MaxIter = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%SumPrint = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumPrint) + Int_Xferred = Int_Xferred + 1 + OutData%OutFile = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TabDelim = TRANSFER(IntKiBuf(Int_Xferred), OutData%TabDelim) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%OutFmt) + OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%Tstart = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutList not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1479,19 +1442,12 @@ SUBROUTINE FEAM_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) + DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) DO I = 1, LEN(OutData%OutList) OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF END SUBROUTINE FEAM_UnPackInputFile @@ -1667,18 +1623,20 @@ SUBROUTINE FEAM_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PtfmInit))-1 ) = PACK(InData%PtfmInit,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PtfmInit) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%InputFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO i1 = LBOUND(InData%PtfmInit,1), UBOUND(InData%PtfmInit,1) + ReKiBuf(Re_Xferred) = InData%PtfmInit(i1) + Re_Xferred = Re_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%NStepWave + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WaveAcc0) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1695,8 +1653,14 @@ SUBROUTINE FEAM_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc0,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveAcc0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveAcc0))-1 ) = PACK(InData%WaveAcc0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveAcc0) + DO i3 = LBOUND(InData%WaveAcc0,3), UBOUND(InData%WaveAcc0,3) + DO i2 = LBOUND(InData%WaveAcc0,2), UBOUND(InData%WaveAcc0,2) + DO i1 = LBOUND(InData%WaveAcc0,1), UBOUND(InData%WaveAcc0,1) + ReKiBuf(Re_Xferred) = InData%WaveAcc0(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveTime) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1708,8 +1672,10 @@ SUBROUTINE FEAM_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveTime)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveTime))-1 ) = PACK(InData%WaveTime,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveTime) + DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) + ReKiBuf(Re_Xferred) = InData%WaveTime(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveVel0) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1727,13 +1693,19 @@ SUBROUTINE FEAM_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel0,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveVel0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveVel0))-1 ) = PACK(InData%WaveVel0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveVel0) + DO i3 = LBOUND(InData%WaveVel0,3), UBOUND(InData%WaveVel0,3) + DO i2 = LBOUND(InData%WaveVel0,2), UBOUND(InData%WaveVel0,2) + DO i1 = LBOUND(InData%WaveVel0,1), UBOUND(InData%WaveVel0,1) + ReKiBuf(Re_Xferred) = InData%WaveVel0(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WtrDens - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Gravity + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDens + Re_Xferred = Re_Xferred + 1 END SUBROUTINE FEAM_PackInitInput SUBROUTINE FEAM_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1749,12 +1721,6 @@ SUBROUTINE FEAM_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (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 @@ -1771,27 +1737,22 @@ SUBROUTINE FEAM_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%InputFile) - OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%InputFile) + OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I i1_l = LBOUND(OutData%PtfmInit,1) i1_u = UBOUND(OutData%PtfmInit,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%PtfmInit = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PtfmInit))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PtfmInit) - DEALLOCATE(mask1) - OutData%NStepWave = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%PtfmInit,1), UBOUND(OutData%PtfmInit,1) + OutData%PtfmInit(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%NStepWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAcc0 not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1811,15 +1772,14 @@ SUBROUTINE FEAM_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%WaveAcc0)>0) OutData%WaveAcc0 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveAcc0))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveAcc0) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%WaveAcc0,3), UBOUND(OutData%WaveAcc0,3) + DO i2 = LBOUND(OutData%WaveAcc0,2), UBOUND(OutData%WaveAcc0,2) + DO i1 = LBOUND(OutData%WaveAcc0,1), UBOUND(OutData%WaveAcc0,1) + OutData%WaveAcc0(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated Int_Xferred = Int_Xferred + 1 @@ -1834,15 +1794,10 @@ SUBROUTINE FEAM_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveTime)>0) OutData%WaveTime = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveTime))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveTime) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) + OutData%WaveTime(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveVel0 not allocated Int_Xferred = Int_Xferred + 1 @@ -1863,20 +1818,19 @@ SUBROUTINE FEAM_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%WaveVel0)>0) OutData%WaveVel0 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveVel0))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveVel0) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%WaveVel0,3), UBOUND(OutData%WaveVel0,3) + DO i2 = LBOUND(OutData%WaveVel0,2), UBOUND(OutData%WaveVel0,2) + DO i1 = LBOUND(OutData%WaveVel0,1), UBOUND(OutData%WaveVel0,1) + OutData%WaveVel0(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - OutData%Gravity = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%Gravity = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WtrDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE FEAM_UnPackInitInput SUBROUTINE FEAM_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -2161,12 +2115,12 @@ SUBROUTINE FEAM_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2178,12 +2132,12 @@ SUBROUTINE FEAM_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + 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) @@ -2223,8 +2177,10 @@ SUBROUTINE FEAM_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LAnchxi,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LAnchxi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LAnchxi))-1 ) = PACK(InData%LAnchxi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LAnchxi) + DO i1 = LBOUND(InData%LAnchxi,1), UBOUND(InData%LAnchxi,1) + ReKiBuf(Re_Xferred) = InData%LAnchxi(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LAnchyi) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2236,8 +2192,10 @@ SUBROUTINE FEAM_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LAnchyi,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LAnchyi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LAnchyi))-1 ) = PACK(InData%LAnchyi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LAnchyi) + DO i1 = LBOUND(InData%LAnchyi,1), UBOUND(InData%LAnchyi,1) + ReKiBuf(Re_Xferred) = InData%LAnchyi(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LAnchzi) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2249,8 +2207,10 @@ SUBROUTINE FEAM_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LAnchzi,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LAnchzi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LAnchzi))-1 ) = PACK(InData%LAnchzi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LAnchzi) + DO i1 = LBOUND(InData%LAnchzi,1), UBOUND(InData%LAnchzi,1) + ReKiBuf(Re_Xferred) = InData%LAnchzi(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LFairxt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2262,8 +2222,10 @@ SUBROUTINE FEAM_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LFairxt,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LFairxt)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LFairxt))-1 ) = PACK(InData%LFairxt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LFairxt) + DO i1 = LBOUND(InData%LFairxt,1), UBOUND(InData%LFairxt,1) + ReKiBuf(Re_Xferred) = InData%LFairxt(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LFairyt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2275,8 +2237,10 @@ SUBROUTINE FEAM_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LFairyt,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LFairyt)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LFairyt))-1 ) = PACK(InData%LFairyt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LFairyt) + DO i1 = LBOUND(InData%LFairyt,1), UBOUND(InData%LFairyt,1) + ReKiBuf(Re_Xferred) = InData%LFairyt(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LFairzt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2288,8 +2252,10 @@ SUBROUTINE FEAM_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LFairzt,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LFairzt)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LFairzt))-1 ) = PACK(InData%LFairzt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LFairzt) + DO i1 = LBOUND(InData%LFairzt,1), UBOUND(InData%LFairzt,1) + ReKiBuf(Re_Xferred) = InData%LFairzt(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE FEAM_PackInitOutput @@ -2306,12 +2272,6 @@ SUBROUTINE FEAM_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -2339,19 +2299,12 @@ SUBROUTINE FEAM_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated Int_Xferred = Int_Xferred + 1 @@ -2366,19 +2319,12 @@ SUBROUTINE FEAM_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -2433,15 +2379,10 @@ SUBROUTINE FEAM_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LAnchxi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LAnchxi)>0) OutData%LAnchxi = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LAnchxi))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LAnchxi) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LAnchxi,1), UBOUND(OutData%LAnchxi,1) + OutData%LAnchxi(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LAnchyi not allocated Int_Xferred = Int_Xferred + 1 @@ -2456,15 +2397,10 @@ SUBROUTINE FEAM_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LAnchyi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LAnchyi)>0) OutData%LAnchyi = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LAnchyi))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LAnchyi) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LAnchyi,1), UBOUND(OutData%LAnchyi,1) + OutData%LAnchyi(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LAnchzi not allocated Int_Xferred = Int_Xferred + 1 @@ -2479,15 +2415,10 @@ SUBROUTINE FEAM_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LAnchzi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LAnchzi)>0) OutData%LAnchzi = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LAnchzi))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LAnchzi) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LAnchzi,1), UBOUND(OutData%LAnchzi,1) + OutData%LAnchzi(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LFairxt not allocated Int_Xferred = Int_Xferred + 1 @@ -2502,15 +2433,10 @@ SUBROUTINE FEAM_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LFairxt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LFairxt)>0) OutData%LFairxt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LFairxt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LFairxt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LFairxt,1), UBOUND(OutData%LFairxt,1) + OutData%LFairxt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LFairyt not allocated Int_Xferred = Int_Xferred + 1 @@ -2525,15 +2451,10 @@ SUBROUTINE FEAM_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LFairyt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LFairyt)>0) OutData%LFairyt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LFairyt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LFairyt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LFairyt,1), UBOUND(OutData%LFairyt,1) + OutData%LFairyt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LFairzt not allocated Int_Xferred = Int_Xferred + 1 @@ -2548,15 +2469,10 @@ SUBROUTINE FEAM_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LFairzt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LFairzt)>0) OutData%LFairzt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LFairzt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LFairzt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LFairzt,1), UBOUND(OutData%LFairzt,1) + OutData%LFairzt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE FEAM_UnPackInitOutput @@ -2708,8 +2624,12 @@ SUBROUTINE FEAM_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLU,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%GLU)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GLU))-1 ) = PACK(InData%GLU,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GLU) + DO i2 = LBOUND(InData%GLU,2), UBOUND(InData%GLU,2) + DO i1 = LBOUND(InData%GLU,1), UBOUND(InData%GLU,1) + ReKiBuf(Re_Xferred) = InData%GLU(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%GLDU) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2724,8 +2644,12 @@ SUBROUTINE FEAM_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLDU,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%GLDU)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GLDU))-1 ) = PACK(InData%GLDU,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GLDU) + DO i2 = LBOUND(InData%GLDU,2), UBOUND(InData%GLDU,2) + DO i1 = LBOUND(InData%GLDU,1), UBOUND(InData%GLDU,1) + ReKiBuf(Re_Xferred) = InData%GLDU(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE FEAM_PackContState @@ -2742,12 +2666,6 @@ SUBROUTINE FEAM_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -2779,15 +2697,12 @@ SUBROUTINE FEAM_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GLU.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%GLU)>0) OutData%GLU = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GLU))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GLU) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%GLU,2), UBOUND(OutData%GLU,2) + DO i1 = LBOUND(OutData%GLU,1), UBOUND(OutData%GLU,1) + OutData%GLU(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GLDU not allocated Int_Xferred = Int_Xferred + 1 @@ -2805,15 +2720,12 @@ SUBROUTINE FEAM_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GLDU.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%GLDU)>0) OutData%GLDU = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GLDU))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GLDU) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%GLDU,2), UBOUND(OutData%GLDU,2) + DO i1 = LBOUND(OutData%GLDU,1), UBOUND(OutData%GLDU,1) + OutData%GLDU(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE FEAM_UnPackContState @@ -2908,8 +2820,8 @@ SUBROUTINE FEAM_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyDiscState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyDiscState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE FEAM_PackDiscState SUBROUTINE FEAM_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2925,12 +2837,6 @@ SUBROUTINE FEAM_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_UnPackDiscState' @@ -2944,8 +2850,8 @@ SUBROUTINE FEAM_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyDiscState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyDiscState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE FEAM_UnPackDiscState SUBROUTINE FEAM_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) @@ -3042,10 +2948,14 @@ SUBROUTINE FEAM_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TSN))-1 ) = PACK(InData%TSN,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TSN) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TZER))-1 ) = PACK(InData%TZER,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TZER) + DO i1 = LBOUND(InData%TSN,1), UBOUND(InData%TSN,1) + ReKiBuf(Re_Xferred) = InData%TSN(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%TZER,1), UBOUND(InData%TZER,1) + ReKiBuf(Re_Xferred) = InData%TZER(i1) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE FEAM_PackConstrState SUBROUTINE FEAM_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -3061,12 +2971,6 @@ SUBROUTINE FEAM_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -3083,26 +2987,16 @@ SUBROUTINE FEAM_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Xferred = 1 i1_l = LBOUND(OutData%TSN,1) i1_u = UBOUND(OutData%TSN,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%TSN = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TSN))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TSN) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TSN,1), UBOUND(OutData%TSN,1) + OutData%TSN(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%TZER,1) i1_u = UBOUND(OutData%TZER,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%TZER = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TZER))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TZER) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TZER,1), UBOUND(OutData%TZER,1) + OutData%TZER(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE FEAM_UnPackConstrState SUBROUTINE FEAM_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -3359,8 +3253,12 @@ SUBROUTINE FEAM_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLU0,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%GLU0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GLU0))-1 ) = PACK(InData%GLU0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GLU0) + DO i2 = LBOUND(InData%GLU0,2), UBOUND(InData%GLU0,2) + DO i1 = LBOUND(InData%GLU0,1), UBOUND(InData%GLU0,1) + ReKiBuf(Re_Xferred) = InData%GLU0(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%GLDDU) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3375,11 +3273,15 @@ SUBROUTINE FEAM_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLDDU,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%GLDDU)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GLDDU))-1 ) = PACK(InData%GLDDU,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GLDDU) + DO i2 = LBOUND(InData%GLDDU,2), UBOUND(InData%GLDDU,2) + DO i1 = LBOUND(InData%GLDDU,1), UBOUND(InData%GLDDU,1) + ReKiBuf(Re_Xferred) = InData%GLDDU(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%BottomTouch , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%BottomTouch, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%GFORC0) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -3396,8 +3298,14 @@ SUBROUTINE FEAM_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GFORC0,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%GFORC0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GFORC0))-1 ) = PACK(InData%GFORC0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GFORC0) + DO i3 = LBOUND(InData%GFORC0,3), UBOUND(InData%GFORC0,3) + DO i2 = LBOUND(InData%GFORC0,2), UBOUND(InData%GFORC0,2) + DO i1 = LBOUND(InData%GFORC0,1), UBOUND(InData%GFORC0,1) + ReKiBuf(Re_Xferred) = InData%GFORC0(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%GMASS0) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3418,8 +3326,16 @@ SUBROUTINE FEAM_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GMASS0,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%GMASS0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GMASS0))-1 ) = PACK(InData%GMASS0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GMASS0) + DO i4 = LBOUND(InData%GMASS0,4), UBOUND(InData%GMASS0,4) + DO i3 = LBOUND(InData%GMASS0,3), UBOUND(InData%GMASS0,3) + DO i2 = LBOUND(InData%GMASS0,2), UBOUND(InData%GMASS0,2) + DO i1 = LBOUND(InData%GMASS0,1), UBOUND(InData%GMASS0,1) + ReKiBuf(Re_Xferred) = InData%GMASS0(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%FAST_FPA) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3434,8 +3350,12 @@ SUBROUTINE FEAM_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FAST_FPA,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FAST_FPA)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FAST_FPA))-1 ) = PACK(InData%FAST_FPA,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FAST_FPA) + DO i2 = LBOUND(InData%FAST_FPA,2), UBOUND(InData%FAST_FPA,2) + DO i1 = LBOUND(InData%FAST_FPA,1), UBOUND(InData%FAST_FPA,1) + ReKiBuf(Re_Xferred) = InData%FAST_FPA(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%FAST_RP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3450,17 +3370,29 @@ SUBROUTINE FEAM_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FAST_RP,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FAST_RP)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FAST_RP))-1 ) = PACK(InData%FAST_RP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FAST_RP) + DO i2 = LBOUND(InData%FAST_RP,2), UBOUND(InData%FAST_RP,2) + DO i1 = LBOUND(InData%FAST_RP,1), UBOUND(InData%FAST_RP,1) + ReKiBuf(Re_Xferred) = InData%FAST_RP(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%INCR - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RSDF))-1 ) = PACK(InData%RSDF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RSDF) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FORC0))-1 ) = PACK(InData%FORC0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FORC0) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%EMAS0))-1 ) = PACK(InData%EMAS0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%EMAS0) + IntKiBuf(Int_Xferred) = InData%INCR + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%RSDF,1), UBOUND(InData%RSDF,1) + ReKiBuf(Re_Xferred) = InData%RSDF(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%FORC0,1), UBOUND(InData%FORC0,1) + ReKiBuf(Re_Xferred) = InData%FORC0(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i2 = LBOUND(InData%EMAS0,2), UBOUND(InData%EMAS0,2) + DO i1 = LBOUND(InData%EMAS0,1), UBOUND(InData%EMAS0,1) + ReKiBuf(Re_Xferred) = InData%EMAS0(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END SUBROUTINE FEAM_PackOtherState SUBROUTINE FEAM_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -3476,12 +3408,6 @@ SUBROUTINE FEAM_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (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 @@ -3515,15 +3441,12 @@ SUBROUTINE FEAM_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GLU0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%GLU0)>0) OutData%GLU0 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GLU0))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GLU0) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%GLU0,2), UBOUND(OutData%GLU0,2) + DO i1 = LBOUND(OutData%GLU0,1), UBOUND(OutData%GLU0,1) + OutData%GLU0(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GLDDU not allocated Int_Xferred = Int_Xferred + 1 @@ -3541,18 +3464,15 @@ SUBROUTINE FEAM_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GLDDU.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%GLDDU)>0) OutData%GLDDU = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GLDDU))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GLDDU) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%GLDDU,2), UBOUND(OutData%GLDDU,2) + DO i1 = LBOUND(OutData%GLDDU,1), UBOUND(OutData%GLDDU,1) + OutData%GLDDU(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - OutData%BottomTouch = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%BottomTouch = TRANSFER(IntKiBuf(Int_Xferred), OutData%BottomTouch) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GFORC0 not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3572,15 +3492,14 @@ SUBROUTINE FEAM_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GFORC0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%GFORC0)>0) OutData%GFORC0 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GFORC0))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GFORC0) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%GFORC0,3), UBOUND(OutData%GFORC0,3) + DO i2 = LBOUND(OutData%GFORC0,2), UBOUND(OutData%GFORC0,2) + DO i1 = LBOUND(OutData%GFORC0,1), UBOUND(OutData%GFORC0,1) + OutData%GFORC0(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GMASS0 not allocated Int_Xferred = Int_Xferred + 1 @@ -3604,15 +3523,16 @@ SUBROUTINE FEAM_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GMASS0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%GMASS0)>0) OutData%GMASS0 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GMASS0))-1 ), mask4, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GMASS0) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%GMASS0,4), UBOUND(OutData%GMASS0,4) + DO i3 = LBOUND(OutData%GMASS0,3), UBOUND(OutData%GMASS0,3) + DO i2 = LBOUND(OutData%GMASS0,2), UBOUND(OutData%GMASS0,2) + DO i1 = LBOUND(OutData%GMASS0,1), UBOUND(OutData%GMASS0,1) + OutData%GMASS0(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FAST_FPA not allocated Int_Xferred = Int_Xferred + 1 @@ -3630,15 +3550,12 @@ SUBROUTINE FEAM_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FAST_FPA.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%FAST_FPA)>0) OutData%FAST_FPA = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FAST_FPA))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FAST_FPA) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%FAST_FPA,2), UBOUND(OutData%FAST_FPA,2) + DO i1 = LBOUND(OutData%FAST_FPA,1), UBOUND(OutData%FAST_FPA,1) + OutData%FAST_FPA(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FAST_RP not allocated Int_Xferred = Int_Xferred + 1 @@ -3656,53 +3573,37 @@ SUBROUTINE FEAM_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FAST_RP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%FAST_RP)>0) OutData%FAST_RP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FAST_RP))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FAST_RP) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%FAST_RP,2), UBOUND(OutData%FAST_RP,2) + DO i1 = LBOUND(OutData%FAST_RP,1), UBOUND(OutData%FAST_RP,1) + OutData%FAST_RP(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - OutData%INCR = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%INCR = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%RSDF,1) i1_u = UBOUND(OutData%RSDF,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%RSDF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RSDF))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RSDF) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%RSDF,1), UBOUND(OutData%RSDF,1) + OutData%RSDF(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%FORC0,1) i1_u = UBOUND(OutData%FORC0,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%FORC0 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FORC0))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FORC0) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FORC0,1), UBOUND(OutData%FORC0,1) + OutData%FORC0(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%EMAS0,1) i1_u = UBOUND(OutData%EMAS0,1) i2_l = LBOUND(OutData%EMAS0,2) i2_u = UBOUND(OutData%EMAS0,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%EMAS0 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%EMAS0))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%EMAS0) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%EMAS0,2), UBOUND(OutData%EMAS0,2) + DO i1 = LBOUND(OutData%EMAS0,1), UBOUND(OutData%EMAS0,1) + OutData%EMAS0(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END SUBROUTINE FEAM_UnPackOtherState SUBROUTINE FEAM_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) @@ -4060,8 +3961,12 @@ SUBROUTINE FEAM_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLF,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%GLF)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GLF))-1 ) = PACK(InData%GLF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GLF) + DO i2 = LBOUND(InData%GLF,2), UBOUND(InData%GLF,2) + DO i1 = LBOUND(InData%GLF,1), UBOUND(InData%GLF,1) + ReKiBuf(Re_Xferred) = InData%GLF(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%GLK) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4079,13 +3984,27 @@ SUBROUTINE FEAM_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLK,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%GLK)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GLK))-1 ) = PACK(InData%GLK,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GLK) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%EMASS))-1 ) = PACK(InData%EMASS,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%EMASS) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%ESTIF))-1 ) = PACK(InData%ESTIF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%ESTIF) + DO i3 = LBOUND(InData%GLK,3), UBOUND(InData%GLK,3) + DO i2 = LBOUND(InData%GLK,2), UBOUND(InData%GLK,2) + DO i1 = LBOUND(InData%GLK,1), UBOUND(InData%GLK,1) + ReKiBuf(Re_Xferred) = InData%GLK(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + DO i2 = LBOUND(InData%EMASS,2), UBOUND(InData%EMASS,2) + DO i1 = LBOUND(InData%EMASS,1), UBOUND(InData%EMASS,1) + ReKiBuf(Re_Xferred) = InData%EMASS(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%ESTIF,2), UBOUND(InData%ESTIF,2) + DO i1 = LBOUND(InData%ESTIF,1), UBOUND(InData%ESTIF,1) + ReKiBuf(Re_Xferred) = InData%ESTIF(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO IF ( .NOT. ALLOCATED(InData%FAST_FP) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4099,31 +4018,67 @@ SUBROUTINE FEAM_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FAST_FP,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FAST_FP)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FAST_FP))-1 ) = PACK(InData%FAST_FP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FAST_FP) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FORCE))-1 ) = PACK(InData%FORCE,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FORCE) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FP))-1 ) = PACK(InData%FP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FP) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%U))-1 ) = PACK(InData%U,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%U) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%U0))-1 ) = PACK(InData%U0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%U0) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%DU))-1 ) = PACK(InData%DU,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%DU) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%DDU))-1 ) = PACK(InData%DDU,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%DDU) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%R))-1 ) = PACK(InData%R,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%R) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RP))-1 ) = PACK(InData%RP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RP) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RHSR))-1 ) = PACK(InData%RHSR,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RHSR) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SLIN))-1 ) = PACK(InData%SLIN,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SLIN) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%STIFR))-1 ) = PACK(InData%STIFR,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%STIFR) + DO i2 = LBOUND(InData%FAST_FP,2), UBOUND(InData%FAST_FP,2) + DO i1 = LBOUND(InData%FAST_FP,1), UBOUND(InData%FAST_FP,1) + ReKiBuf(Re_Xferred) = InData%FAST_FP(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + DO i1 = LBOUND(InData%FORCE,1), UBOUND(InData%FORCE,1) + ReKiBuf(Re_Xferred) = InData%FORCE(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%FP,1), UBOUND(InData%FP,1) + ReKiBuf(Re_Xferred) = InData%FP(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i2 = LBOUND(InData%U,2), UBOUND(InData%U,2) + DO i1 = LBOUND(InData%U,1), UBOUND(InData%U,1) + ReKiBuf(Re_Xferred) = InData%U(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%U0,2), UBOUND(InData%U0,2) + DO i1 = LBOUND(InData%U0,1), UBOUND(InData%U0,1) + ReKiBuf(Re_Xferred) = InData%U0(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%DU,2), UBOUND(InData%DU,2) + DO i1 = LBOUND(InData%DU,1), UBOUND(InData%DU,1) + ReKiBuf(Re_Xferred) = InData%DU(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%DDU,2), UBOUND(InData%DDU,2) + DO i1 = LBOUND(InData%DDU,1), UBOUND(InData%DDU,1) + ReKiBuf(Re_Xferred) = InData%DDU(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i1 = LBOUND(InData%R,1), UBOUND(InData%R,1) + ReKiBuf(Re_Xferred) = InData%R(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%RP,1), UBOUND(InData%RP,1) + ReKiBuf(Re_Xferred) = InData%RP(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%RHSR,1), UBOUND(InData%RHSR,1) + ReKiBuf(Re_Xferred) = InData%RHSR(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%SLIN,1), UBOUND(InData%SLIN,1) + ReKiBuf(Re_Xferred) = InData%SLIN(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i2 = LBOUND(InData%STIFR,2), UBOUND(InData%STIFR,2) + DO i1 = LBOUND(InData%STIFR,1), UBOUND(InData%STIFR,1) + ReKiBuf(Re_Xferred) = InData%STIFR(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO IF ( .NOT. ALLOCATED(InData%FAIR_ANG) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4137,8 +4092,12 @@ SUBROUTINE FEAM_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FAIR_ANG,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FAIR_ANG)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FAIR_ANG))-1 ) = PACK(InData%FAIR_ANG,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FAIR_ANG) + DO i2 = LBOUND(InData%FAIR_ANG,2), UBOUND(InData%FAIR_ANG,2) + DO i1 = LBOUND(InData%FAIR_ANG,1), UBOUND(InData%FAIR_ANG,1) + ReKiBuf(Re_Xferred) = InData%FAIR_ANG(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%FAIR_T) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4150,8 +4109,10 @@ SUBROUTINE FEAM_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FAIR_T,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FAIR_T)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FAIR_T))-1 ) = PACK(InData%FAIR_T,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FAIR_T) + DO i1 = LBOUND(InData%FAIR_T,1), UBOUND(InData%FAIR_T,1) + ReKiBuf(Re_Xferred) = InData%FAIR_T(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%ANCH_ANG) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4166,8 +4127,12 @@ SUBROUTINE FEAM_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ANCH_ANG,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ANCH_ANG)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%ANCH_ANG))-1 ) = PACK(InData%ANCH_ANG,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%ANCH_ANG) + DO i2 = LBOUND(InData%ANCH_ANG,2), UBOUND(InData%ANCH_ANG,2) + DO i1 = LBOUND(InData%ANCH_ANG,1), UBOUND(InData%ANCH_ANG,1) + ReKiBuf(Re_Xferred) = InData%ANCH_ANG(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%ANCH_T) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4179,8 +4144,10 @@ SUBROUTINE FEAM_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ANCH_T,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ANCH_T)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%ANCH_T))-1 ) = PACK(InData%ANCH_T,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%ANCH_T) + DO i1 = LBOUND(InData%ANCH_T,1), UBOUND(InData%ANCH_T,1) + ReKiBuf(Re_Xferred) = InData%ANCH_T(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%Line_Coordinate) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4198,8 +4165,14 @@ SUBROUTINE FEAM_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Line_Coordinate,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Line_Coordinate)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Line_Coordinate))-1 ) = PACK(InData%Line_Coordinate,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Line_Coordinate) + DO i3 = LBOUND(InData%Line_Coordinate,3), UBOUND(InData%Line_Coordinate,3) + DO i2 = LBOUND(InData%Line_Coordinate,2), UBOUND(InData%Line_Coordinate,2) + DO i1 = LBOUND(InData%Line_Coordinate,1), UBOUND(InData%Line_Coordinate,1) + ReKiBuf(Re_Xferred) = InData%Line_Coordinate(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Line_Tangent) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4217,8 +4190,14 @@ SUBROUTINE FEAM_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Line_Tangent,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Line_Tangent)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Line_Tangent))-1 ) = PACK(InData%Line_Tangent,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Line_Tangent) + DO i3 = LBOUND(InData%Line_Tangent,3), UBOUND(InData%Line_Tangent,3) + DO i2 = LBOUND(InData%Line_Tangent,2), UBOUND(InData%Line_Tangent,2) + DO i1 = LBOUND(InData%Line_Tangent,1), UBOUND(InData%Line_Tangent,1) + ReKiBuf(Re_Xferred) = InData%Line_Tangent(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%F_Lines) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4233,11 +4212,15 @@ SUBROUTINE FEAM_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_Lines,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%F_Lines)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F_Lines))-1 ) = PACK(InData%F_Lines,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F_Lines) + DO i2 = LBOUND(InData%F_Lines,2), UBOUND(InData%F_Lines,2) + DO i1 = LBOUND(InData%F_Lines,1), UBOUND(InData%F_Lines,1) + ReKiBuf(Re_Xferred) = InData%F_Lines(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%LastIndWave - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%LastIndWave + Int_Xferred = Int_Xferred + 1 END SUBROUTINE FEAM_PackMisc SUBROUTINE FEAM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -4253,12 +4236,6 @@ SUBROUTINE FEAM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (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 @@ -4291,15 +4268,12 @@ SUBROUTINE FEAM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GLF.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%GLF)>0) OutData%GLF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GLF))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GLF) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%GLF,2), UBOUND(OutData%GLF,2) + DO i1 = LBOUND(OutData%GLF,1), UBOUND(OutData%GLF,1) + OutData%GLF(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GLK not allocated Int_Xferred = Int_Xferred + 1 @@ -4320,42 +4294,35 @@ SUBROUTINE FEAM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GLK.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%GLK)>0) OutData%GLK = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GLK))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GLK) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%GLK,3), UBOUND(OutData%GLK,3) + DO i2 = LBOUND(OutData%GLK,2), UBOUND(OutData%GLK,2) + DO i1 = LBOUND(OutData%GLK,1), UBOUND(OutData%GLK,1) + OutData%GLK(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF i1_l = LBOUND(OutData%EMASS,1) i1_u = UBOUND(OutData%EMASS,1) i2_l = LBOUND(OutData%EMASS,2) i2_u = UBOUND(OutData%EMASS,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%EMASS = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%EMASS))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%EMASS) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%EMASS,2), UBOUND(OutData%EMASS,2) + DO i1 = LBOUND(OutData%EMASS,1), UBOUND(OutData%EMASS,1) + OutData%EMASS(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%ESTIF,1) i1_u = UBOUND(OutData%ESTIF,1) i2_l = LBOUND(OutData%ESTIF,2) i2_u = UBOUND(OutData%ESTIF,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%ESTIF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%ESTIF))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%ESTIF) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%ESTIF,2), UBOUND(OutData%ESTIF,2) + DO i1 = LBOUND(OutData%ESTIF,1), UBOUND(OutData%ESTIF,1) + OutData%ESTIF(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FAST_FP not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -4372,147 +4339,99 @@ SUBROUTINE FEAM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FAST_FP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%FAST_FP)>0) OutData%FAST_FP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FAST_FP))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FAST_FP) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%FAST_FP,2), UBOUND(OutData%FAST_FP,2) + DO i1 = LBOUND(OutData%FAST_FP,1), UBOUND(OutData%FAST_FP,1) + OutData%FAST_FP(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF i1_l = LBOUND(OutData%FORCE,1) i1_u = UBOUND(OutData%FORCE,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%FORCE = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FORCE))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FORCE) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FORCE,1), UBOUND(OutData%FORCE,1) + OutData%FORCE(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%FP,1) i1_u = UBOUND(OutData%FP,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%FP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FP))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FP) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FP,1), UBOUND(OutData%FP,1) + OutData%FP(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%U,1) i1_u = UBOUND(OutData%U,1) i2_l = LBOUND(OutData%U,2) i2_u = UBOUND(OutData%U,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%U = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%U))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%U) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%U,2), UBOUND(OutData%U,2) + DO i1 = LBOUND(OutData%U,1), UBOUND(OutData%U,1) + OutData%U(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%U0,1) i1_u = UBOUND(OutData%U0,1) i2_l = LBOUND(OutData%U0,2) i2_u = UBOUND(OutData%U0,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%U0 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%U0))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%U0) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%U0,2), UBOUND(OutData%U0,2) + DO i1 = LBOUND(OutData%U0,1), UBOUND(OutData%U0,1) + OutData%U0(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%DU,1) i1_u = UBOUND(OutData%DU,1) i2_l = LBOUND(OutData%DU,2) i2_u = UBOUND(OutData%DU,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%DU = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%DU))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%DU) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%DU,2), UBOUND(OutData%DU,2) + DO i1 = LBOUND(OutData%DU,1), UBOUND(OutData%DU,1) + OutData%DU(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%DDU,1) i1_u = UBOUND(OutData%DDU,1) i2_l = LBOUND(OutData%DDU,2) i2_u = UBOUND(OutData%DDU,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%DDU = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%DDU))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%DDU) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%DDU,2), UBOUND(OutData%DDU,2) + DO i1 = LBOUND(OutData%DDU,1), UBOUND(OutData%DDU,1) + OutData%DDU(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%R,1) i1_u = UBOUND(OutData%R,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%R = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%R))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%R) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%R,1), UBOUND(OutData%R,1) + OutData%R(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%RP,1) i1_u = UBOUND(OutData%RP,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%RP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RP))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RP) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%RP,1), UBOUND(OutData%RP,1) + OutData%RP(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%RHSR,1) i1_u = UBOUND(OutData%RHSR,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%RHSR = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RHSR))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RHSR) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%RHSR,1), UBOUND(OutData%RHSR,1) + OutData%RHSR(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%SLIN,1) i1_u = UBOUND(OutData%SLIN,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%SLIN = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SLIN))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SLIN) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%SLIN,1), UBOUND(OutData%SLIN,1) + OutData%SLIN(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%STIFR,1) i1_u = UBOUND(OutData%STIFR,1) i2_l = LBOUND(OutData%STIFR,2) i2_u = UBOUND(OutData%STIFR,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%STIFR = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%STIFR))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%STIFR) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%STIFR,2), UBOUND(OutData%STIFR,2) + DO i1 = LBOUND(OutData%STIFR,1), UBOUND(OutData%STIFR,1) + OutData%STIFR(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FAIR_ANG not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -4529,15 +4448,12 @@ SUBROUTINE FEAM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FAIR_ANG.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%FAIR_ANG)>0) OutData%FAIR_ANG = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FAIR_ANG))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FAIR_ANG) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%FAIR_ANG,2), UBOUND(OutData%FAIR_ANG,2) + DO i1 = LBOUND(OutData%FAIR_ANG,1), UBOUND(OutData%FAIR_ANG,1) + OutData%FAIR_ANG(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FAIR_T not allocated Int_Xferred = Int_Xferred + 1 @@ -4552,15 +4468,10 @@ SUBROUTINE FEAM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FAIR_T.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%FAIR_T)>0) OutData%FAIR_T = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FAIR_T))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FAIR_T) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FAIR_T,1), UBOUND(OutData%FAIR_T,1) + OutData%FAIR_T(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ANCH_ANG not allocated Int_Xferred = Int_Xferred + 1 @@ -4578,15 +4489,12 @@ SUBROUTINE FEAM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ANCH_ANG.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%ANCH_ANG)>0) OutData%ANCH_ANG = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%ANCH_ANG))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%ANCH_ANG) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%ANCH_ANG,2), UBOUND(OutData%ANCH_ANG,2) + DO i1 = LBOUND(OutData%ANCH_ANG,1), UBOUND(OutData%ANCH_ANG,1) + OutData%ANCH_ANG(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ANCH_T not allocated Int_Xferred = Int_Xferred + 1 @@ -4601,15 +4509,10 @@ SUBROUTINE FEAM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ANCH_T.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%ANCH_T)>0) OutData%ANCH_T = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%ANCH_T))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%ANCH_T) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%ANCH_T,1), UBOUND(OutData%ANCH_T,1) + OutData%ANCH_T(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Line_Coordinate not allocated Int_Xferred = Int_Xferred + 1 @@ -4630,15 +4533,14 @@ SUBROUTINE FEAM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Line_Coordinate.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%Line_Coordinate)>0) OutData%Line_Coordinate = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Line_Coordinate))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Line_Coordinate) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%Line_Coordinate,3), UBOUND(OutData%Line_Coordinate,3) + DO i2 = LBOUND(OutData%Line_Coordinate,2), UBOUND(OutData%Line_Coordinate,2) + DO i1 = LBOUND(OutData%Line_Coordinate,1), UBOUND(OutData%Line_Coordinate,1) + OutData%Line_Coordinate(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Line_Tangent not allocated Int_Xferred = Int_Xferred + 1 @@ -4659,15 +4561,14 @@ SUBROUTINE FEAM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Line_Tangent.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%Line_Tangent)>0) OutData%Line_Tangent = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Line_Tangent))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Line_Tangent) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%Line_Tangent,3), UBOUND(OutData%Line_Tangent,3) + DO i2 = LBOUND(OutData%Line_Tangent,2), UBOUND(OutData%Line_Tangent,2) + DO i1 = LBOUND(OutData%Line_Tangent,1), UBOUND(OutData%Line_Tangent,1) + OutData%Line_Tangent(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_Lines not allocated Int_Xferred = Int_Xferred + 1 @@ -4685,18 +4586,15 @@ SUBROUTINE FEAM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_Lines.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%F_Lines)>0) OutData%F_Lines = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F_Lines))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F_Lines) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%F_Lines,2), UBOUND(OutData%F_Lines,2) + DO i1 = LBOUND(OutData%F_Lines,1), UBOUND(OutData%F_Lines,1) + OutData%F_Lines(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - OutData%LastIndWave = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%LastIndWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE FEAM_UnPackMisc SUBROUTINE FEAM_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -5268,22 +5166,24 @@ SUBROUTINE FEAM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GRAV))-1 ) = PACK(InData%GRAV,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GRAV) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Eps - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WtrDens - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MaxIter - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NHBD - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NDIM - Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(InData%GRAV,1), UBOUND(InData%GRAV,1) + ReKiBuf(Re_Xferred) = InData%GRAV(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%Eps + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Gravity + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDens + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MaxIter + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NHBD + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NDIM + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%NEQ) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -5294,17 +5194,19 @@ SUBROUTINE FEAM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NEQ,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%NEQ)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%NEQ))-1 ) = PACK(InData%NEQ,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%NEQ) + DO i1 = LBOUND(InData%NEQ,1), UBOUND(InData%NEQ,1) + IntKiBuf(Int_Xferred) = InData%NEQ(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NBAND - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumLines - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumElems - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumNodes - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NBAND + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumLines + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumElems + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumNodes + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%GSL) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -5321,8 +5223,14 @@ SUBROUTINE FEAM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GSL,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%GSL)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GSL))-1 ) = PACK(InData%GSL,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GSL) + DO i3 = LBOUND(InData%GSL,3), UBOUND(InData%GSL,3) + DO i2 = LBOUND(InData%GSL,2), UBOUND(InData%GSL,2) + DO i1 = LBOUND(InData%GSL,1), UBOUND(InData%GSL,1) + ReKiBuf(Re_Xferred) = InData%GSL(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%GP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5337,8 +5245,12 @@ SUBROUTINE FEAM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GP,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%GP)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GP))-1 ) = PACK(InData%GP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GP) + DO i2 = LBOUND(InData%GP,2), UBOUND(InData%GP,2) + DO i1 = LBOUND(InData%GP,1), UBOUND(InData%GP,1) + ReKiBuf(Re_Xferred) = InData%GP(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Elength) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5350,8 +5262,10 @@ SUBROUTINE FEAM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Elength,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Elength)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Elength))-1 ) = PACK(InData%Elength,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Elength) + DO i1 = LBOUND(InData%Elength,1), UBOUND(InData%Elength,1) + ReKiBuf(Re_Xferred) = InData%Elength(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%BottmElev) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5363,8 +5277,10 @@ SUBROUTINE FEAM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BottmElev,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BottmElev)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BottmElev))-1 ) = PACK(InData%BottmElev,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BottmElev) + DO i1 = LBOUND(InData%BottmElev,1), UBOUND(InData%BottmElev,1) + ReKiBuf(Re_Xferred) = InData%BottmElev(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%BottmStiff) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5376,8 +5292,10 @@ SUBROUTINE FEAM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BottmStiff,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BottmStiff)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BottmStiff))-1 ) = PACK(InData%BottmStiff,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BottmStiff) + DO i1 = LBOUND(InData%BottmStiff,1), UBOUND(InData%BottmStiff,1) + ReKiBuf(Re_Xferred) = InData%BottmStiff(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LMassDen) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5389,8 +5307,10 @@ SUBROUTINE FEAM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LMassDen,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LMassDen)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LMassDen))-1 ) = PACK(InData%LMassDen,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LMassDen) + DO i1 = LBOUND(InData%LMassDen,1), UBOUND(InData%LMassDen,1) + ReKiBuf(Re_Xferred) = InData%LMassDen(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LDMassDen) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5402,8 +5322,10 @@ SUBROUTINE FEAM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LDMassDen,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LDMassDen)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LDMassDen))-1 ) = PACK(InData%LDMassDen,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LDMassDen) + DO i1 = LBOUND(InData%LDMassDen,1), UBOUND(InData%LDMassDen,1) + ReKiBuf(Re_Xferred) = InData%LDMassDen(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LEAStiff) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5415,8 +5337,10 @@ SUBROUTINE FEAM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LEAStiff,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LEAStiff)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LEAStiff))-1 ) = PACK(InData%LEAStiff,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LEAStiff) + DO i1 = LBOUND(InData%LEAStiff,1), UBOUND(InData%LEAStiff,1) + ReKiBuf(Re_Xferred) = InData%LEAStiff(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LineCI) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5428,8 +5352,10 @@ SUBROUTINE FEAM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LineCI,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LineCI)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LineCI))-1 ) = PACK(InData%LineCI,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LineCI) + DO i1 = LBOUND(InData%LineCI,1), UBOUND(InData%LineCI,1) + ReKiBuf(Re_Xferred) = InData%LineCI(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LineCD) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5441,8 +5367,10 @@ SUBROUTINE FEAM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LineCD,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LineCD)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LineCD))-1 ) = PACK(InData%LineCD,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LineCD) + DO i1 = LBOUND(InData%LineCD,1), UBOUND(InData%LineCD,1) + ReKiBuf(Re_Xferred) = InData%LineCD(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%Bvp) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5457,8 +5385,12 @@ SUBROUTINE FEAM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Bvp,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Bvp)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Bvp))-1 ) = PACK(InData%Bvp,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Bvp) + DO i2 = LBOUND(InData%Bvp,2), UBOUND(InData%Bvp,2) + DO i1 = LBOUND(InData%Bvp,1), UBOUND(InData%Bvp,1) + ReKiBuf(Re_Xferred) = InData%Bvp(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveAcc0) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5476,8 +5408,14 @@ SUBROUTINE FEAM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc0,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveAcc0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveAcc0))-1 ) = PACK(InData%WaveAcc0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveAcc0) + DO i3 = LBOUND(InData%WaveAcc0,3), UBOUND(InData%WaveAcc0,3) + DO i2 = LBOUND(InData%WaveAcc0,2), UBOUND(InData%WaveAcc0,2) + DO i1 = LBOUND(InData%WaveAcc0,1), UBOUND(InData%WaveAcc0,1) + ReKiBuf(Re_Xferred) = InData%WaveAcc0(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveTime) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5489,8 +5427,10 @@ SUBROUTINE FEAM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveTime)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveTime))-1 ) = PACK(InData%WaveTime,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveTime) + DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) + ReKiBuf(Re_Xferred) = InData%WaveTime(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveVel0) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5508,53 +5448,119 @@ SUBROUTINE FEAM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel0,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveVel0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveVel0))-1 ) = PACK(InData%WaveVel0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveVel0) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SHAP))-1 ) = PACK(InData%SHAP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SHAP) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SHAPS))-1 ) = PACK(InData%SHAPS,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SHAPS) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GAUSSW))-1 ) = PACK(InData%GAUSSW,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GAUSSW) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NGAUSS - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SHAPT))-1 ) = PACK(InData%SHAPT,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SHAPT) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SHAPTS))-1 ) = PACK(InData%SHAPTS,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SHAPTS) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NTRAP - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SBEND))-1 ) = PACK(InData%SBEND,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SBEND) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%STEN))-1 ) = PACK(InData%STEN,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%STEN) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RMASS))-1 ) = PACK(InData%RMASS,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RMASS) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RADDM))-1 ) = PACK(InData%RADDM,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RADDM) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PMPN))-1 ) = PACK(InData%PMPN,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PMPN) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AM))-1 ) = PACK(InData%AM,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AM) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PM))-1 ) = PACK(InData%PM,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PM) - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%IDOF))-1 ) = PACK(InData%IDOF,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%IDOF) - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%JDOF))-1 ) = PACK(InData%JDOF,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%JDOF) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PPA))-1 ) = PACK(InData%PPA,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PPA) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmRefzt - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO i3 = LBOUND(InData%WaveVel0,3), UBOUND(InData%WaveVel0,3) + DO i2 = LBOUND(InData%WaveVel0,2), UBOUND(InData%WaveVel0,2) + DO i1 = LBOUND(InData%WaveVel0,1), UBOUND(InData%WaveVel0,1) + ReKiBuf(Re_Xferred) = InData%WaveVel0(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + IntKiBuf(Int_Xferred) = InData%NStepWave + Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(InData%SHAP,2), UBOUND(InData%SHAP,2) + DO i1 = LBOUND(InData%SHAP,1), UBOUND(InData%SHAP,1) + ReKiBuf(Re_Xferred) = InData%SHAP(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%SHAPS,2), UBOUND(InData%SHAPS,2) + DO i1 = LBOUND(InData%SHAPS,1), UBOUND(InData%SHAPS,1) + ReKiBuf(Re_Xferred) = InData%SHAPS(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i1 = LBOUND(InData%GAUSSW,1), UBOUND(InData%GAUSSW,1) + ReKiBuf(Re_Xferred) = InData%GAUSSW(i1) + Re_Xferred = Re_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%NGAUSS + Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(InData%SHAPT,2), UBOUND(InData%SHAPT,2) + DO i1 = LBOUND(InData%SHAPT,1), UBOUND(InData%SHAPT,1) + ReKiBuf(Re_Xferred) = InData%SHAPT(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%SHAPTS,2), UBOUND(InData%SHAPTS,2) + DO i1 = LBOUND(InData%SHAPTS,1), UBOUND(InData%SHAPTS,1) + ReKiBuf(Re_Xferred) = InData%SHAPTS(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + IntKiBuf(Int_Xferred) = InData%NTRAP + Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(InData%SBEND,2), UBOUND(InData%SBEND,2) + DO i1 = LBOUND(InData%SBEND,1), UBOUND(InData%SBEND,1) + ReKiBuf(Re_Xferred) = InData%SBEND(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i3 = LBOUND(InData%STEN,3), UBOUND(InData%STEN,3) + DO i2 = LBOUND(InData%STEN,2), UBOUND(InData%STEN,2) + DO i1 = LBOUND(InData%STEN,1), UBOUND(InData%STEN,1) + ReKiBuf(Re_Xferred) = InData%STEN(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + DO i2 = LBOUND(InData%RMASS,2), UBOUND(InData%RMASS,2) + DO i1 = LBOUND(InData%RMASS,1), UBOUND(InData%RMASS,1) + ReKiBuf(Re_Xferred) = InData%RMASS(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i4 = LBOUND(InData%RADDM,4), UBOUND(InData%RADDM,4) + DO i3 = LBOUND(InData%RADDM,3), UBOUND(InData%RADDM,3) + DO i2 = LBOUND(InData%RADDM,2), UBOUND(InData%RADDM,2) + DO i1 = LBOUND(InData%RADDM,1), UBOUND(InData%RADDM,1) + ReKiBuf(Re_Xferred) = InData%RADDM(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + DO i2 = LBOUND(InData%PMPN,2), UBOUND(InData%PMPN,2) + DO i1 = LBOUND(InData%PMPN,1), UBOUND(InData%PMPN,1) + ReKiBuf(Re_Xferred) = InData%PMPN(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i1 = LBOUND(InData%AM,1), UBOUND(InData%AM,1) + ReKiBuf(Re_Xferred) = InData%AM(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%PM,1), UBOUND(InData%PM,1) + ReKiBuf(Re_Xferred) = InData%PM(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i2 = LBOUND(InData%IDOF,2), UBOUND(InData%IDOF,2) + DO i1 = LBOUND(InData%IDOF,1), UBOUND(InData%IDOF,1) + IntKiBuf(Int_Xferred) = InData%IDOF(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + DO i1 = LBOUND(InData%JDOF,1), UBOUND(InData%JDOF,1) + IntKiBuf(Int_Xferred) = InData%JDOF(i1) + Int_Xferred = Int_Xferred + 1 + END DO + DO i3 = LBOUND(InData%PPA,3), UBOUND(InData%PPA,3) + DO i2 = LBOUND(InData%PPA,2), UBOUND(InData%PPA,2) + DO i1 = LBOUND(InData%PPA,1), UBOUND(InData%PPA,1) + ReKiBuf(Re_Xferred) = InData%PPA(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + ReKiBuf(Re_Xferred) = InData%PtfmRefzt + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( .NOT. ALLOCATED(InData%OutParam) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -5596,10 +5602,10 @@ SUBROUTINE FEAM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, ENDIF END DO END IF - DO I = 1, LEN(InData%Delim) - IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(InData%Delim) + IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( .NOT. ALLOCATED(InData%GLUZR) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -5616,8 +5622,14 @@ SUBROUTINE FEAM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GLUZR,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%GLUZR)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GLUZR))-1 ) = PACK(InData%GLUZR,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GLUZR) + DO i3 = LBOUND(InData%GLUZR,3), UBOUND(InData%GLUZR,3) + DO i2 = LBOUND(InData%GLUZR,2), UBOUND(InData%GLUZR,2) + DO i1 = LBOUND(InData%GLUZR,1), UBOUND(InData%GLUZR,1) + ReKiBuf(Re_Xferred) = InData%GLUZR(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%GTZER) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5632,8 +5644,12 @@ SUBROUTINE FEAM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GTZER,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%GTZER)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GTZER))-1 ) = PACK(InData%GTZER,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GTZER) + DO i2 = LBOUND(InData%GTZER,2), UBOUND(InData%GTZER,2) + DO i1 = LBOUND(InData%GTZER,1), UBOUND(InData%GTZER,1) + ReKiBuf(Re_Xferred) = InData%GTZER(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE FEAM_PackParam @@ -5650,12 +5666,6 @@ SUBROUTINE FEAM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (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 @@ -5673,31 +5683,26 @@ SUBROUTINE FEAM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 i1_l = LBOUND(OutData%GRAV,1) i1_u = UBOUND(OutData%GRAV,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%GRAV = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GRAV))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GRAV) - DEALLOCATE(mask1) - OutData%Eps = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Gravity = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MaxIter = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NHBD = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NDIM = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%GRAV,1), UBOUND(OutData%GRAV,1) + OutData%GRAV(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%Eps = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Gravity = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WtrDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MaxIter = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NHBD = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NDIM = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NEQ not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5711,24 +5716,19 @@ SUBROUTINE FEAM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NEQ.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%NEQ)>0) OutData%NEQ = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%NEQ))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%NEQ) - DEALLOCATE(mask1) - END IF - OutData%NBAND = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumLines = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumElems = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumNodes = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%NEQ,1), UBOUND(OutData%NEQ,1) + OutData%NEQ(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + OutData%NBAND = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumLines = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumElems = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumNodes = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GSL not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5748,15 +5748,14 @@ SUBROUTINE FEAM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GSL.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%GSL)>0) OutData%GSL = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GSL))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GSL) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%GSL,3), UBOUND(OutData%GSL,3) + DO i2 = LBOUND(OutData%GSL,2), UBOUND(OutData%GSL,2) + DO i1 = LBOUND(OutData%GSL,1), UBOUND(OutData%GSL,1) + OutData%GSL(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GP not allocated Int_Xferred = Int_Xferred + 1 @@ -5774,15 +5773,12 @@ SUBROUTINE FEAM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%GP)>0) OutData%GP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GP))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GP) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%GP,2), UBOUND(OutData%GP,2) + DO i1 = LBOUND(OutData%GP,1), UBOUND(OutData%GP,1) + OutData%GP(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Elength not allocated Int_Xferred = Int_Xferred + 1 @@ -5797,15 +5793,10 @@ SUBROUTINE FEAM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Elength.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Elength)>0) OutData%Elength = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Elength))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Elength) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Elength,1), UBOUND(OutData%Elength,1) + OutData%Elength(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BottmElev not allocated Int_Xferred = Int_Xferred + 1 @@ -5820,15 +5811,10 @@ SUBROUTINE FEAM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BottmElev.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BottmElev)>0) OutData%BottmElev = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BottmElev))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BottmElev) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BottmElev,1), UBOUND(OutData%BottmElev,1) + OutData%BottmElev(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BottmStiff not allocated Int_Xferred = Int_Xferred + 1 @@ -5843,15 +5829,10 @@ SUBROUTINE FEAM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BottmStiff.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BottmStiff)>0) OutData%BottmStiff = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BottmStiff))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BottmStiff) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BottmStiff,1), UBOUND(OutData%BottmStiff,1) + OutData%BottmStiff(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LMassDen not allocated Int_Xferred = Int_Xferred + 1 @@ -5866,15 +5847,10 @@ SUBROUTINE FEAM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LMassDen.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LMassDen)>0) OutData%LMassDen = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LMassDen))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LMassDen) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LMassDen,1), UBOUND(OutData%LMassDen,1) + OutData%LMassDen(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LDMassDen not allocated Int_Xferred = Int_Xferred + 1 @@ -5889,15 +5865,10 @@ SUBROUTINE FEAM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LDMassDen.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LDMassDen)>0) OutData%LDMassDen = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LDMassDen))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LDMassDen) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LDMassDen,1), UBOUND(OutData%LDMassDen,1) + OutData%LDMassDen(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LEAStiff not allocated Int_Xferred = Int_Xferred + 1 @@ -5912,15 +5883,10 @@ SUBROUTINE FEAM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LEAStiff.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LEAStiff)>0) OutData%LEAStiff = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LEAStiff))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LEAStiff) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LEAStiff,1), UBOUND(OutData%LEAStiff,1) + OutData%LEAStiff(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LineCI not allocated Int_Xferred = Int_Xferred + 1 @@ -5935,15 +5901,10 @@ SUBROUTINE FEAM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineCI.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LineCI)>0) OutData%LineCI = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LineCI))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LineCI) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LineCI,1), UBOUND(OutData%LineCI,1) + OutData%LineCI(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LineCD not allocated Int_Xferred = Int_Xferred + 1 @@ -5958,15 +5919,10 @@ SUBROUTINE FEAM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineCD.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LineCD)>0) OutData%LineCD = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LineCD))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LineCD) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LineCD,1), UBOUND(OutData%LineCD,1) + OutData%LineCD(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Bvp not allocated Int_Xferred = Int_Xferred + 1 @@ -5984,15 +5940,12 @@ SUBROUTINE FEAM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Bvp.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Bvp)>0) OutData%Bvp = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Bvp))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Bvp) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Bvp,2), UBOUND(OutData%Bvp,2) + DO i1 = LBOUND(OutData%Bvp,1), UBOUND(OutData%Bvp,1) + OutData%Bvp(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAcc0 not allocated Int_Xferred = Int_Xferred + 1 @@ -6013,15 +5966,14 @@ SUBROUTINE FEAM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%WaveAcc0)>0) OutData%WaveAcc0 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveAcc0))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveAcc0) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%WaveAcc0,3), UBOUND(OutData%WaveAcc0,3) + DO i2 = LBOUND(OutData%WaveAcc0,2), UBOUND(OutData%WaveAcc0,2) + DO i1 = LBOUND(OutData%WaveAcc0,1), UBOUND(OutData%WaveAcc0,1) + OutData%WaveAcc0(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated Int_Xferred = Int_Xferred + 1 @@ -6036,15 +5988,10 @@ SUBROUTINE FEAM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveTime)>0) OutData%WaveTime = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveTime))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveTime) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) + OutData%WaveTime(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveVel0 not allocated Int_Xferred = Int_Xferred + 1 @@ -6065,126 +6012,101 @@ SUBROUTINE FEAM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%WaveVel0)>0) OutData%WaveVel0 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveVel0))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveVel0) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%WaveVel0,3), UBOUND(OutData%WaveVel0,3) + DO i2 = LBOUND(OutData%WaveVel0,2), UBOUND(OutData%WaveVel0,2) + DO i1 = LBOUND(OutData%WaveVel0,1), UBOUND(OutData%WaveVel0,1) + OutData%WaveVel0(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - OutData%NStepWave = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NStepWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%SHAP,1) i1_u = UBOUND(OutData%SHAP,1) i2_l = LBOUND(OutData%SHAP,2) i2_u = UBOUND(OutData%SHAP,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%SHAP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SHAP))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SHAP) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%SHAP,2), UBOUND(OutData%SHAP,2) + DO i1 = LBOUND(OutData%SHAP,1), UBOUND(OutData%SHAP,1) + OutData%SHAP(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%SHAPS,1) i1_u = UBOUND(OutData%SHAPS,1) i2_l = LBOUND(OutData%SHAPS,2) i2_u = UBOUND(OutData%SHAPS,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%SHAPS = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SHAPS))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SHAPS) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%SHAPS,2), UBOUND(OutData%SHAPS,2) + DO i1 = LBOUND(OutData%SHAPS,1), UBOUND(OutData%SHAPS,1) + OutData%SHAPS(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%GAUSSW,1) i1_u = UBOUND(OutData%GAUSSW,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%GAUSSW = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GAUSSW))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GAUSSW) - DEALLOCATE(mask1) - OutData%NGAUSS = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%GAUSSW,1), UBOUND(OutData%GAUSSW,1) + OutData%GAUSSW(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%NGAUSS = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%SHAPT,1) i1_u = UBOUND(OutData%SHAPT,1) i2_l = LBOUND(OutData%SHAPT,2) i2_u = UBOUND(OutData%SHAPT,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%SHAPT = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SHAPT))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SHAPT) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%SHAPT,2), UBOUND(OutData%SHAPT,2) + DO i1 = LBOUND(OutData%SHAPT,1), UBOUND(OutData%SHAPT,1) + OutData%SHAPT(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%SHAPTS,1) i1_u = UBOUND(OutData%SHAPTS,1) i2_l = LBOUND(OutData%SHAPTS,2) i2_u = UBOUND(OutData%SHAPTS,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%SHAPTS = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SHAPTS))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SHAPTS) - DEALLOCATE(mask2) - OutData%NTRAP = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(OutData%SHAPTS,2), UBOUND(OutData%SHAPTS,2) + DO i1 = LBOUND(OutData%SHAPTS,1), UBOUND(OutData%SHAPTS,1) + OutData%SHAPTS(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + OutData%NTRAP = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%SBEND,1) i1_u = UBOUND(OutData%SBEND,1) i2_l = LBOUND(OutData%SBEND,2) i2_u = UBOUND(OutData%SBEND,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%SBEND = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SBEND))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SBEND) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%SBEND,2), UBOUND(OutData%SBEND,2) + DO i1 = LBOUND(OutData%SBEND,1), UBOUND(OutData%SBEND,1) + OutData%SBEND(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%STEN,1) i1_u = UBOUND(OutData%STEN,1) i2_l = LBOUND(OutData%STEN,2) i2_u = UBOUND(OutData%STEN,2) i3_l = LBOUND(OutData%STEN,3) i3_u = UBOUND(OutData%STEN,3) - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - OutData%STEN = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%STEN))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%STEN) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%STEN,3), UBOUND(OutData%STEN,3) + DO i2 = LBOUND(OutData%STEN,2), UBOUND(OutData%STEN,2) + DO i1 = LBOUND(OutData%STEN,1), UBOUND(OutData%STEN,1) + OutData%STEN(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO i1_l = LBOUND(OutData%RMASS,1) i1_u = UBOUND(OutData%RMASS,1) i2_l = LBOUND(OutData%RMASS,2) i2_u = UBOUND(OutData%RMASS,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%RMASS = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RMASS))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RMASS) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%RMASS,2), UBOUND(OutData%RMASS,2) + DO i1 = LBOUND(OutData%RMASS,1), UBOUND(OutData%RMASS,1) + OutData%RMASS(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%RADDM,1) i1_u = UBOUND(OutData%RADDM,1) i2_l = LBOUND(OutData%RADDM,2) @@ -6193,97 +6115,76 @@ SUBROUTINE FEAM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs i3_u = UBOUND(OutData%RADDM,3) i4_l = LBOUND(OutData%RADDM,4) i4_u = UBOUND(OutData%RADDM,4) - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - OutData%RADDM = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RADDM))-1 ), mask4, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RADDM) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%RADDM,4), UBOUND(OutData%RADDM,4) + DO i3 = LBOUND(OutData%RADDM,3), UBOUND(OutData%RADDM,3) + DO i2 = LBOUND(OutData%RADDM,2), UBOUND(OutData%RADDM,2) + DO i1 = LBOUND(OutData%RADDM,1), UBOUND(OutData%RADDM,1) + OutData%RADDM(i1,i2,i3,i4) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO i1_l = LBOUND(OutData%PMPN,1) i1_u = UBOUND(OutData%PMPN,1) i2_l = LBOUND(OutData%PMPN,2) i2_u = UBOUND(OutData%PMPN,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%PMPN = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PMPN))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PMPN) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PMPN,2), UBOUND(OutData%PMPN,2) + DO i1 = LBOUND(OutData%PMPN,1), UBOUND(OutData%PMPN,1) + OutData%PMPN(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%AM,1) i1_u = UBOUND(OutData%AM,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%AM = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AM))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AM) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AM,1), UBOUND(OutData%AM,1) + OutData%AM(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%PM,1) i1_u = UBOUND(OutData%PM,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%PM = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PM))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PM) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%PM,1), UBOUND(OutData%PM,1) + OutData%PM(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%IDOF,1) i1_u = UBOUND(OutData%IDOF,1) i2_l = LBOUND(OutData%IDOF,2) i2_u = UBOUND(OutData%IDOF,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%IDOF = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%IDOF))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%IDOF) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%IDOF,2), UBOUND(OutData%IDOF,2) + DO i1 = LBOUND(OutData%IDOF,1), UBOUND(OutData%IDOF,1) + OutData%IDOF(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%JDOF,1) i1_u = UBOUND(OutData%JDOF,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%JDOF = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%JDOF))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%JDOF) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%JDOF,1), UBOUND(OutData%JDOF,1) + OutData%JDOF(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO i1_l = LBOUND(OutData%PPA,1) i1_u = UBOUND(OutData%PPA,1) i2_l = LBOUND(OutData%PPA,2) i2_u = UBOUND(OutData%PPA,2) i3_l = LBOUND(OutData%PPA,3) i3_u = UBOUND(OutData%PPA,3) - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - OutData%PPA = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PPA))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PPA) - DEALLOCATE(mask3) - OutData%PtfmRefzt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO i3 = LBOUND(OutData%PPA,3), UBOUND(OutData%PPA,3) + DO i2 = LBOUND(OutData%PPA,2), UBOUND(OutData%PPA,2) + DO i1 = LBOUND(OutData%PPA,1), UBOUND(OutData%PPA,1) + OutData%PPA(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + OutData%PtfmRefzt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParam not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -6340,10 +6241,10 @@ SUBROUTINE FEAM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - DO I = 1, LEN(OutData%Delim) - OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%Delim) + OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GLUZR not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -6363,15 +6264,14 @@ SUBROUTINE FEAM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GLUZR.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%GLUZR)>0) OutData%GLUZR = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GLUZR))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GLUZR) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%GLUZR,3), UBOUND(OutData%GLUZR,3) + DO i2 = LBOUND(OutData%GLUZR,2), UBOUND(OutData%GLUZR,2) + DO i1 = LBOUND(OutData%GLUZR,1), UBOUND(OutData%GLUZR,1) + OutData%GLUZR(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GTZER not allocated Int_Xferred = Int_Xferred + 1 @@ -6389,15 +6289,12 @@ SUBROUTINE FEAM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GTZER.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%GTZER)>0) OutData%GTZER = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GTZER))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GTZER) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%GTZER,2), UBOUND(OutData%GTZER,2) + DO i1 = LBOUND(OutData%GTZER,1), UBOUND(OutData%GTZER,1) + OutData%GTZER(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE FEAM_UnPackParam @@ -6604,12 +6501,6 @@ SUBROUTINE FEAM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_UnPackInput' @@ -6868,8 +6759,10 @@ SUBROUTINE FEAM_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WriteOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WriteOutput))-1 ) = PACK(InData%WriteOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WriteOutput) + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF CALL MeshPack( InData%PtFairleadLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! PtFairleadLoad CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6942,12 +6835,6 @@ SUBROUTINE FEAM_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -6975,15 +6862,10 @@ SUBROUTINE FEAM_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WriteOutput)>0) OutData%WriteOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WriteOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WriteOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -7142,8 +7024,8 @@ SUBROUTINE FEAM_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -7158,6 +7040,8 @@ SUBROUTINE FEAM_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(u1%HydroForceLineMesh, u2%HydroForceLineMesh, tin, u_out%HydroForceLineMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL MeshExtrapInterp1(u1%PtFairleadDisplacement, u2%PtFairleadDisplacement, tin, u_out%PtFairleadDisplacement, tin_out, ErrStat2, ErrMsg2 ) @@ -7191,8 +7075,9 @@ SUBROUTINE FEAM_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_Input_ExtrapInterp2' @@ -7214,6 +7099,8 @@ SUBROUTINE FEAM_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(u1%HydroForceLineMesh, u2%HydroForceLineMesh, u3%HydroForceLineMesh, tin, u_out%HydroForceLineMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL MeshExtrapInterp2(u1%PtFairleadDisplacement, u2%PtFairleadDisplacement, u3%PtFairleadDisplacement, tin, u_out%PtFairleadDisplacement, tin_out, ErrStat2, ErrMsg2 ) @@ -7295,12 +7182,12 @@ SUBROUTINE FEAM_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -7313,13 +7200,13 @@ SUBROUTINE FEAM_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = -(y1%WriteOutput - y2%WriteOutput)/t(2) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO END IF ! check if allocated CALL MeshExtrapInterp1(y1%PtFairleadLoad, y2%PtFairleadLoad, tin, y_out%PtFairleadLoad, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) @@ -7354,13 +7241,14 @@ SUBROUTINE FEAM_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'FEAM_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -7379,14 +7267,14 @@ SUBROUTINE FEAM_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = (t(3)**2*(y1%WriteOutput - y2%WriteOutput) + t(2)**2*(-y1%WriteOutput + y3%WriteOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WriteOutput + t(3)*y2%WriteOutput - t(2)*y3%WriteOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO END IF ! check if allocated CALL MeshExtrapInterp2(y1%PtFairleadLoad, y2%PtFairleadLoad, y3%PtFairleadLoad, tin, y_out%PtFairleadLoad, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) diff --git a/modules/hydrodyn/src/Conv_Radiation_Types.f90 b/modules/hydrodyn/src/Conv_Radiation_Types.f90 index e5dd8d3382..cbbf1b3868 100644 --- a/modules/hydrodyn/src/Conv_Radiation_Types.f90 +++ b/modules/hydrodyn/src/Conv_Radiation_Types.f90 @@ -268,18 +268,18 @@ SUBROUTINE Conv_Rdtn_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%RdtnDT - Db_Xferred = Db_Xferred + 1 - DO I = 1, LEN(InData%RdtnDTChr) - IntKiBuf(Int_Xferred) = ICHAR(InData%RdtnDTChr(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HighFreq - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%WAMITFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%WAMITFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DbKiBuf(Db_Xferred) = InData%RdtnDT + Db_Xferred = Db_Xferred + 1 + DO I = 1, LEN(InData%RdtnDTChr) + IntKiBuf(Int_Xferred) = ICHAR(InData%RdtnDTChr(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + ReKiBuf(Re_Xferred) = InData%HighFreq + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(InData%WAMITFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%WAMITFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( .NOT. ALLOCATED(InData%HdroAddMs) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -293,8 +293,12 @@ SUBROUTINE Conv_Rdtn_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HdroAddMs,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%HdroAddMs)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%HdroAddMs))-1 ) = PACK(InData%HdroAddMs,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%HdroAddMs) + DO i2 = LBOUND(InData%HdroAddMs,2), UBOUND(InData%HdroAddMs,2) + DO i1 = LBOUND(InData%HdroAddMs,1), UBOUND(InData%HdroAddMs,1) + ReKiBuf(Re_Xferred) = InData%HdroAddMs(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%HdroFreq) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -306,8 +310,10 @@ SUBROUTINE Conv_Rdtn_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HdroFreq,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%HdroFreq)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%HdroFreq))-1 ) = PACK(InData%HdroFreq,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%HdroFreq) + DO i1 = LBOUND(InData%HdroFreq,1), UBOUND(InData%HdroFreq,1) + ReKiBuf(Re_Xferred) = InData%HdroFreq(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%HdroDmpng) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -322,15 +328,19 @@ SUBROUTINE Conv_Rdtn_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HdroDmpng,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%HdroDmpng)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%HdroDmpng))-1 ) = PACK(InData%HdroDmpng,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%HdroDmpng) + DO i2 = LBOUND(InData%HdroDmpng,2), UBOUND(InData%HdroDmpng,2) + DO i1 = LBOUND(InData%HdroDmpng,1), UBOUND(InData%HdroDmpng,1) + ReKiBuf(Re_Xferred) = InData%HdroDmpng(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NInpFreq - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%RdtnTMax - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UnSum - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NInpFreq + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%RdtnTMax + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%UnSum + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Conv_Rdtn_PackInitInput SUBROUTINE Conv_Rdtn_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -346,12 +356,6 @@ SUBROUTINE Conv_Rdtn_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (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 @@ -368,18 +372,18 @@ SUBROUTINE Conv_Rdtn_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%RdtnDT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - DO I = 1, LEN(OutData%RdtnDTChr) - OutData%RdtnDTChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%HighFreq = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%WAMITFile) - OutData%WAMITFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + OutData%RdtnDT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + DO I = 1, LEN(OutData%RdtnDTChr) + OutData%RdtnDTChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%HighFreq = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(OutData%WAMITFile) + OutData%WAMITFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! HdroAddMs not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -396,15 +400,12 @@ SUBROUTINE Conv_Rdtn_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%HdroAddMs.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%HdroAddMs)>0) OutData%HdroAddMs = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%HdroAddMs))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%HdroAddMs) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%HdroAddMs,2), UBOUND(OutData%HdroAddMs,2) + DO i1 = LBOUND(OutData%HdroAddMs,1), UBOUND(OutData%HdroAddMs,1) + OutData%HdroAddMs(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! HdroFreq not allocated Int_Xferred = Int_Xferred + 1 @@ -419,15 +420,10 @@ SUBROUTINE Conv_Rdtn_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%HdroFreq.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%HdroFreq)>0) OutData%HdroFreq = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%HdroFreq))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%HdroFreq) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%HdroFreq,1), UBOUND(OutData%HdroFreq,1) + OutData%HdroFreq(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! HdroDmpng not allocated Int_Xferred = Int_Xferred + 1 @@ -445,22 +441,19 @@ SUBROUTINE Conv_Rdtn_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%HdroDmpng.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%HdroDmpng)>0) OutData%HdroDmpng = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%HdroDmpng))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%HdroDmpng) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%HdroDmpng,2), UBOUND(OutData%HdroDmpng,2) + DO i1 = LBOUND(OutData%HdroDmpng,1), UBOUND(OutData%HdroDmpng,1) + OutData%HdroDmpng(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - OutData%NInpFreq = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%RdtnTMax = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%UnSum = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NInpFreq = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%RdtnTMax = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%UnSum = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Conv_Rdtn_UnPackInitInput SUBROUTINE Conv_Rdtn_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -554,8 +547,8 @@ SUBROUTINE Conv_Rdtn_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DummyInitOut - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DummyInitOut + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Conv_Rdtn_PackInitOutput SUBROUTINE Conv_Rdtn_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -571,12 +564,6 @@ SUBROUTINE Conv_Rdtn_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_UnPackInitOutput' @@ -590,8 +577,8 @@ SUBROUTINE Conv_Rdtn_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyInitOut = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%DummyInitOut = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Conv_Rdtn_UnPackInitOutput SUBROUTINE Conv_Rdtn_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) @@ -685,8 +672,8 @@ SUBROUTINE Conv_Rdtn_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyContState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyContState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Conv_Rdtn_PackContState SUBROUTINE Conv_Rdtn_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -702,12 +689,6 @@ SUBROUTINE Conv_Rdtn_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_UnPackContState' @@ -721,8 +702,8 @@ SUBROUTINE Conv_Rdtn_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyContState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyContState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Conv_Rdtn_UnPackContState SUBROUTINE Conv_Rdtn_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) @@ -853,11 +834,15 @@ SUBROUTINE Conv_Rdtn_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%XDHistory,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%XDHistory)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%XDHistory))-1 ) = PACK(InData%XDHistory,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%XDHistory) + DO i2 = LBOUND(InData%XDHistory,2), UBOUND(InData%XDHistory,2) + DO i1 = LBOUND(InData%XDHistory,1), UBOUND(InData%XDHistory,1) + ReKiBuf(Re_Xferred) = InData%XDHistory(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%LastTime - Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%LastTime + Db_Xferred = Db_Xferred + 1 END SUBROUTINE Conv_Rdtn_PackDiscState SUBROUTINE Conv_Rdtn_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -873,12 +858,6 @@ SUBROUTINE Conv_Rdtn_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -910,18 +889,15 @@ SUBROUTINE Conv_Rdtn_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%XDHistory.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%XDHistory)>0) OutData%XDHistory = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%XDHistory))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%XDHistory) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%XDHistory,2), UBOUND(OutData%XDHistory,2) + DO i1 = LBOUND(OutData%XDHistory,1), UBOUND(OutData%XDHistory,1) + OutData%XDHistory(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - OutData%LastTime = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%LastTime = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 END SUBROUTINE Conv_Rdtn_UnPackDiscState SUBROUTINE Conv_Rdtn_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) @@ -1015,8 +991,8 @@ SUBROUTINE Conv_Rdtn_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyConstrState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Conv_Rdtn_PackConstrState SUBROUTINE Conv_Rdtn_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1032,12 +1008,6 @@ SUBROUTINE Conv_Rdtn_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_UnPackConstrState' @@ -1051,8 +1021,8 @@ SUBROUTINE Conv_Rdtn_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyConstrState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyConstrState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Conv_Rdtn_UnPackConstrState SUBROUTINE Conv_Rdtn_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -1146,8 +1116,8 @@ SUBROUTINE Conv_Rdtn_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%IndRdtn - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%IndRdtn + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Conv_Rdtn_PackOtherState SUBROUTINE Conv_Rdtn_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1163,12 +1133,6 @@ SUBROUTINE Conv_Rdtn_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_UnPackOtherState' @@ -1182,8 +1146,8 @@ SUBROUTINE Conv_Rdtn_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%IndRdtn = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%IndRdtn = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Conv_Rdtn_UnPackOtherState SUBROUTINE Conv_Rdtn_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) @@ -1277,8 +1241,8 @@ SUBROUTINE Conv_Rdtn_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%LastIndRdtn - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%LastIndRdtn + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Conv_Rdtn_PackMisc SUBROUTINE Conv_Rdtn_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1294,12 +1258,6 @@ SUBROUTINE Conv_Rdtn_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_UnPackMisc' @@ -1313,8 +1271,8 @@ SUBROUTINE Conv_Rdtn_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%LastIndRdtn = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%LastIndRdtn = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Conv_Rdtn_UnPackMisc SUBROUTINE Conv_Rdtn_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -1441,10 +1399,10 @@ SUBROUTINE Conv_Rdtn_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%RdtnDT - Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%RdtnDT + Db_Xferred = Db_Xferred + 1 IF ( .NOT. ALLOCATED(InData%RdtnKrnl) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1461,13 +1419,19 @@ SUBROUTINE Conv_Rdtn_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RdtnKrnl,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RdtnKrnl)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RdtnKrnl))-1 ) = PACK(InData%RdtnKrnl,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RdtnKrnl) + DO i3 = LBOUND(InData%RdtnKrnl,3), UBOUND(InData%RdtnKrnl,3) + DO i2 = LBOUND(InData%RdtnKrnl,2), UBOUND(InData%RdtnKrnl,2) + DO i1 = LBOUND(InData%RdtnKrnl,1), UBOUND(InData%RdtnKrnl,1) + ReKiBuf(Re_Xferred) = InData%RdtnKrnl(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NStepRdtn - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NStepRdtn1 - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepRdtn + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepRdtn1 + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Conv_Rdtn_PackParam SUBROUTINE Conv_Rdtn_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1483,12 +1447,6 @@ SUBROUTINE Conv_Rdtn_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (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 @@ -1505,10 +1463,10 @@ SUBROUTINE Conv_Rdtn_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%RdtnDT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%RdtnDT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RdtnKrnl not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1528,20 +1486,19 @@ SUBROUTINE Conv_Rdtn_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RdtnKrnl.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%RdtnKrnl)>0) OutData%RdtnKrnl = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RdtnKrnl))-1 ), mask3, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%RdtnKrnl) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%RdtnKrnl,3), UBOUND(OutData%RdtnKrnl,3) + DO i2 = LBOUND(OutData%RdtnKrnl,2), UBOUND(OutData%RdtnKrnl,2) + DO i1 = LBOUND(OutData%RdtnKrnl,1), UBOUND(OutData%RdtnKrnl,1) + OutData%RdtnKrnl(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - OutData%NStepRdtn = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NStepRdtn1 = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NStepRdtn = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NStepRdtn1 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Conv_Rdtn_UnPackParam SUBROUTINE Conv_Rdtn_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -1636,8 +1593,10 @@ SUBROUTINE Conv_Rdtn_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Velocity))-1 ) = PACK(InData%Velocity,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Velocity) + DO i1 = LBOUND(InData%Velocity,1), UBOUND(InData%Velocity,1) + ReKiBuf(Re_Xferred) = InData%Velocity(i1) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE Conv_Rdtn_PackInput SUBROUTINE Conv_Rdtn_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1653,12 +1612,6 @@ SUBROUTINE Conv_Rdtn_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1675,15 +1628,10 @@ SUBROUTINE Conv_Rdtn_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Xferred = 1 i1_l = LBOUND(OutData%Velocity,1) i1_u = UBOUND(OutData%Velocity,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%Velocity = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Velocity))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Velocity) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Velocity,1), UBOUND(OutData%Velocity,1) + OutData%Velocity(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE Conv_Rdtn_UnPackInput SUBROUTINE Conv_Rdtn_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -1778,8 +1726,10 @@ SUBROUTINE Conv_Rdtn_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F_Rdtn))-1 ) = PACK(InData%F_Rdtn,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F_Rdtn) + DO i1 = LBOUND(InData%F_Rdtn,1), UBOUND(InData%F_Rdtn,1) + ReKiBuf(Re_Xferred) = InData%F_Rdtn(i1) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE Conv_Rdtn_PackOutput SUBROUTINE Conv_Rdtn_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1795,12 +1745,6 @@ SUBROUTINE Conv_Rdtn_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1817,15 +1761,10 @@ SUBROUTINE Conv_Rdtn_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Xferred = 1 i1_l = LBOUND(OutData%F_Rdtn,1) i1_u = UBOUND(OutData%F_Rdtn,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%F_Rdtn = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F_Rdtn))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F_Rdtn) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%F_Rdtn,1), UBOUND(OutData%F_Rdtn,1) + OutData%F_Rdtn(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE Conv_Rdtn_UnPackOutput @@ -1903,12 +1842,12 @@ SUBROUTINE Conv_Rdtn_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, E REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -1921,12 +1860,12 @@ SUBROUTINE Conv_Rdtn_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, E CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(b1(SIZE(u_out%Velocity,1))) - ALLOCATE(c1(SIZE(u_out%Velocity,1))) - b1 = -(u1%Velocity - u2%Velocity)/t(2) - u_out%Velocity = u1%Velocity + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + + ScaleFactor = t_out / t(2) + DO i1 = LBOUND(u_out%Velocity,1),UBOUND(u_out%Velocity,1) + b = -(u1%Velocity(i1) - u2%Velocity(i1)) + u_out%Velocity(i1) = u1%Velocity(i1) + b * ScaleFactor + END DO END SUBROUTINE Conv_Rdtn_Input_ExtrapInterp1 @@ -1956,13 +1895,14 @@ SUBROUTINE Conv_Rdtn_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrSta REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -1981,13 +1921,13 @@ SUBROUTINE Conv_Rdtn_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrSta CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(b1(SIZE(u_out%Velocity,1))) - ALLOCATE(c1(SIZE(u_out%Velocity,1))) - b1 = (t(3)**2*(u1%Velocity - u2%Velocity) + t(2)**2*(-u1%Velocity + u3%Velocity))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%Velocity + t(3)*u2%Velocity - t(2)*u3%Velocity ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Velocity = u1%Velocity + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) + DO i1 = LBOUND(u_out%Velocity,1),UBOUND(u_out%Velocity,1) + b = (t(3)**2*(u1%Velocity(i1) - u2%Velocity(i1)) + t(2)**2*(-u1%Velocity(i1) + u3%Velocity(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%Velocity(i1) + t(3)*u2%Velocity(i1) - t(2)*u3%Velocity(i1) ) * scaleFactor + u_out%Velocity(i1) = u1%Velocity(i1) + b + c * t_out + END DO END SUBROUTINE Conv_Rdtn_Input_ExtrapInterp2 @@ -2065,12 +2005,12 @@ SUBROUTINE Conv_Rdtn_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -2083,12 +2023,12 @@ SUBROUTINE Conv_Rdtn_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(b1(SIZE(y_out%F_Rdtn,1))) - ALLOCATE(c1(SIZE(y_out%F_Rdtn,1))) - b1 = -(y1%F_Rdtn - y2%F_Rdtn)/t(2) - y_out%F_Rdtn = y1%F_Rdtn + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + + ScaleFactor = t_out / t(2) + DO i1 = LBOUND(y_out%F_Rdtn,1),UBOUND(y_out%F_Rdtn,1) + b = -(y1%F_Rdtn(i1) - y2%F_Rdtn(i1)) + y_out%F_Rdtn(i1) = y1%F_Rdtn(i1) + b * ScaleFactor + END DO END SUBROUTINE Conv_Rdtn_Output_ExtrapInterp1 @@ -2118,13 +2058,14 @@ SUBROUTINE Conv_Rdtn_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrSt REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'Conv_Rdtn_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -2143,13 +2084,13 @@ SUBROUTINE Conv_Rdtn_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrSt CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(b1(SIZE(y_out%F_Rdtn,1))) - ALLOCATE(c1(SIZE(y_out%F_Rdtn,1))) - b1 = (t(3)**2*(y1%F_Rdtn - y2%F_Rdtn) + t(2)**2*(-y1%F_Rdtn + y3%F_Rdtn))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%F_Rdtn + t(3)*y2%F_Rdtn - t(2)*y3%F_Rdtn ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%F_Rdtn = y1%F_Rdtn + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) + DO i1 = LBOUND(y_out%F_Rdtn,1),UBOUND(y_out%F_Rdtn,1) + b = (t(3)**2*(y1%F_Rdtn(i1) - y2%F_Rdtn(i1)) + t(2)**2*(-y1%F_Rdtn(i1) + y3%F_Rdtn(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%F_Rdtn(i1) + t(3)*y2%F_Rdtn(i1) - t(2)*y3%F_Rdtn(i1) ) * scaleFactor + y_out%F_Rdtn(i1) = y1%F_Rdtn(i1) + b + c * t_out + END DO END SUBROUTINE Conv_Rdtn_Output_ExtrapInterp2 END MODULE Conv_Radiation_Types diff --git a/modules/hydrodyn/src/Current_Types.f90 b/modules/hydrodyn/src/Current_Types.f90 index a6e1405853..f262434bca 100644 --- a/modules/hydrodyn/src/Current_Types.f90 +++ b/modules/hydrodyn/src/Current_Types.f90 @@ -233,28 +233,28 @@ SUBROUTINE Current_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CurrSSV0 - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%CurrSSDirChr) - IntKiBuf(Int_Xferred) = ICHAR(InData%CurrSSDirChr(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CurrSSDir - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CurrNSRef - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CurrNSV0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CurrNSDir - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CurrDIV - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CurrDIDir - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%CurrMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CurrSSV0 + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(InData%CurrSSDirChr) + IntKiBuf(Int_Xferred) = ICHAR(InData%CurrSSDirChr(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + ReKiBuf(Re_Xferred) = InData%CurrSSDir + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CurrNSRef + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CurrNSV0 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CurrNSDir + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CurrDIV + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CurrDIDir + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%CurrMod + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDpth + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%MorisonNodezi) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -265,15 +265,17 @@ SUBROUTINE Current_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MorisonNodezi,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%MorisonNodezi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MorisonNodezi))-1 ) = PACK(InData%MorisonNodezi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MorisonNodezi) + DO i1 = LBOUND(InData%MorisonNodezi,1), UBOUND(InData%MorisonNodezi,1) + ReKiBuf(Re_Xferred) = InData%MorisonNodezi(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NMorisonNodes - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%DirRoot) - IntKiBuf(Int_Xferred) = ICHAR(InData%DirRoot(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + IntKiBuf(Int_Xferred) = InData%NMorisonNodes + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%DirRoot) + IntKiBuf(Int_Xferred) = ICHAR(InData%DirRoot(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE Current_PackInitInput SUBROUTINE Current_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -289,12 +291,6 @@ SUBROUTINE Current_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -309,28 +305,28 @@ SUBROUTINE Current_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%CurrSSV0 = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%CurrSSDirChr) - OutData%CurrSSDirChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%CurrSSDir = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%CurrNSRef = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%CurrNSV0 = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%CurrNSDir = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%CurrDIV = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%CurrDIDir = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%CurrMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%WtrDpth = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%CurrSSV0 = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(OutData%CurrSSDirChr) + OutData%CurrSSDirChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%CurrSSDir = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%CurrNSRef = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%CurrNSV0 = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%CurrNSDir = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%CurrDIV = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%CurrDIDir = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%CurrMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WtrDpth = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MorisonNodezi not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -344,22 +340,17 @@ SUBROUTINE Current_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MorisonNodezi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%MorisonNodezi)>0) OutData%MorisonNodezi = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MorisonNodezi))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%MorisonNodezi) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%MorisonNodezi,1), UBOUND(OutData%MorisonNodezi,1) + OutData%MorisonNodezi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%NMorisonNodes = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%DirRoot) - OutData%DirRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + OutData%NMorisonNodes = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%DirRoot) + OutData%DirRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE Current_UnPackInitInput SUBROUTINE Current_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -506,8 +497,10 @@ SUBROUTINE Current_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CurrVxi,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CurrVxi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CurrVxi))-1 ) = PACK(InData%CurrVxi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CurrVxi) + DO i1 = LBOUND(InData%CurrVxi,1), UBOUND(InData%CurrVxi,1) + ReKiBuf(Re_Xferred) = InData%CurrVxi(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%CurrVyi) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -519,13 +512,15 @@ SUBROUTINE Current_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CurrVyi,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CurrVyi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CurrVyi))-1 ) = PACK(InData%CurrVyi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CurrVyi) + DO i1 = LBOUND(InData%CurrVyi,1), UBOUND(InData%CurrVyi,1) + ReKiBuf(Re_Xferred) = InData%CurrVyi(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PCurrVxiPz0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PCurrVyiPz0 - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PCurrVxiPz0 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PCurrVyiPz0 + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Current_PackInitOutput SUBROUTINE Current_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -541,12 +536,6 @@ SUBROUTINE Current_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -574,15 +563,10 @@ SUBROUTINE Current_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CurrVxi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%CurrVxi)>0) OutData%CurrVxi = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CurrVxi))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%CurrVxi) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%CurrVxi,1), UBOUND(OutData%CurrVxi,1) + OutData%CurrVxi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CurrVyi not allocated Int_Xferred = Int_Xferred + 1 @@ -597,20 +581,15 @@ SUBROUTINE Current_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CurrVyi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%CurrVyi)>0) OutData%CurrVyi = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CurrVyi))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%CurrVyi) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%CurrVyi,1), UBOUND(OutData%CurrVyi,1) + OutData%CurrVyi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%PCurrVxiPz0 = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%PCurrVyiPz0 = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%PCurrVxiPz0 = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%PCurrVyiPz0 = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Current_UnPackInitOutput SUBROUTINE Current_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) @@ -704,8 +683,8 @@ SUBROUTINE Current_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyContState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyContState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Current_PackContState SUBROUTINE Current_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -721,12 +700,6 @@ SUBROUTINE Current_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Current_UnPackContState' @@ -740,8 +713,8 @@ SUBROUTINE Current_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyContState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyContState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Current_UnPackContState SUBROUTINE Current_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) @@ -835,8 +808,8 @@ SUBROUTINE Current_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyDiscState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyDiscState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Current_PackDiscState SUBROUTINE Current_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -852,12 +825,6 @@ SUBROUTINE Current_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Current_UnPackDiscState' @@ -871,8 +838,8 @@ SUBROUTINE Current_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyDiscState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyDiscState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Current_UnPackDiscState SUBROUTINE Current_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) @@ -966,8 +933,8 @@ SUBROUTINE Current_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyConstrState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Current_PackConstrState SUBROUTINE Current_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -983,12 +950,6 @@ SUBROUTINE Current_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Current_UnPackConstrState' @@ -1002,8 +963,8 @@ SUBROUTINE Current_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyConstrState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyConstrState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Current_UnPackConstrState SUBROUTINE Current_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -1097,8 +1058,8 @@ SUBROUTINE Current_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DummyOtherState - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DummyOtherState + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Current_PackOtherState SUBROUTINE Current_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1114,12 +1075,6 @@ SUBROUTINE Current_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Current_UnPackOtherState' @@ -1133,8 +1088,8 @@ SUBROUTINE Current_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyOtherState = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%DummyOtherState = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Current_UnPackOtherState SUBROUTINE Current_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) @@ -1228,8 +1183,8 @@ SUBROUTINE Current_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyMiscVar - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyMiscVar + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Current_PackMisc SUBROUTINE Current_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1245,12 +1200,6 @@ SUBROUTINE Current_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Current_UnPackMisc' @@ -1264,8 +1213,8 @@ SUBROUTINE Current_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyMiscVar = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyMiscVar = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Current_UnPackMisc SUBROUTINE Current_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -1359,8 +1308,8 @@ SUBROUTINE Current_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 END SUBROUTINE Current_PackParam SUBROUTINE Current_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1376,12 +1325,6 @@ SUBROUTINE Current_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Current_UnPackParam' @@ -1395,8 +1338,8 @@ SUBROUTINE Current_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 END SUBROUTINE Current_UnPackParam SUBROUTINE Current_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -1490,8 +1433,8 @@ SUBROUTINE Current_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyInput - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyInput + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Current_PackInput SUBROUTINE Current_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1507,12 +1450,6 @@ SUBROUTINE Current_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Current_UnPackInput' @@ -1526,8 +1463,8 @@ SUBROUTINE Current_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyInput = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyInput = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Current_UnPackInput SUBROUTINE Current_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -1621,8 +1558,8 @@ SUBROUTINE Current_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyOutput - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyOutput + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Current_PackOutput SUBROUTINE Current_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1638,12 +1575,6 @@ SUBROUTINE Current_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Current_UnPackOutput' @@ -1657,8 +1588,8 @@ SUBROUTINE Current_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyOutput = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyOutput = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Current_UnPackOutput @@ -1736,8 +1667,8 @@ SUBROUTINE Current_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, Err REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'Current_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -1752,8 +1683,10 @@ SUBROUTINE Current_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - b0 = -(u1%DummyInput - u2%DummyInput)/t(2) - u_out%DummyInput = u1%DummyInput + b0 * t_out + + ScaleFactor = t_out / t(2) + b = -(u1%DummyInput - u2%DummyInput) + u_out%DummyInput = u1%DummyInput + b * ScaleFactor END SUBROUTINE Current_Input_ExtrapInterp1 @@ -1783,8 +1716,9 @@ SUBROUTINE Current_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'Current_Input_ExtrapInterp2' @@ -1806,9 +1740,11 @@ SUBROUTINE Current_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - b0 = (t(3)**2*(u1%DummyInput - u2%DummyInput) + t(2)**2*(-u1%DummyInput + u3%DummyInput))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%DummyInput + t(3)*u2%DummyInput - t(2)*u3%DummyInput ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%DummyInput = u1%DummyInput + b0 * t_out + c0 * t_out**2 + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) + b = (t(3)**2*(u1%DummyInput - u2%DummyInput) + t(2)**2*(-u1%DummyInput + u3%DummyInput))* scaleFactor + c = ( (t(2)-t(3))*u1%DummyInput + t(3)*u2%DummyInput - t(2)*u3%DummyInput ) * scaleFactor + u_out%DummyInput = u1%DummyInput + b + c * t_out END SUBROUTINE Current_Input_ExtrapInterp2 @@ -1886,8 +1822,8 @@ SUBROUTINE Current_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, Er REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'Current_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -1902,8 +1838,10 @@ SUBROUTINE Current_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - b0 = -(y1%DummyOutput - y2%DummyOutput)/t(2) - y_out%DummyOutput = y1%DummyOutput + b0 * t_out + + ScaleFactor = t_out / t(2) + b = -(y1%DummyOutput - y2%DummyOutput) + y_out%DummyOutput = y1%DummyOutput + b * ScaleFactor END SUBROUTINE Current_Output_ExtrapInterp1 @@ -1933,8 +1871,9 @@ SUBROUTINE Current_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'Current_Output_ExtrapInterp2' @@ -1956,9 +1895,11 @@ SUBROUTINE Current_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - b0 = (t(3)**2*(y1%DummyOutput - y2%DummyOutput) + t(2)**2*(-y1%DummyOutput + y3%DummyOutput))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%DummyOutput + t(3)*y2%DummyOutput - t(2)*y3%DummyOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%DummyOutput = y1%DummyOutput + b0 * t_out + c0 * t_out**2 + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) + b = (t(3)**2*(y1%DummyOutput - y2%DummyOutput) + t(2)**2*(-y1%DummyOutput + y3%DummyOutput))* scaleFactor + c = ( (t(2)-t(3))*y1%DummyOutput + t(3)*y2%DummyOutput - t(2)*y3%DummyOutput ) * scaleFactor + y_out%DummyOutput = y1%DummyOutput + b + c * t_out END SUBROUTINE Current_Output_ExtrapInterp2 END MODULE Current_Types diff --git a/modules/hydrodyn/src/HydroDyn.f90 b/modules/hydrodyn/src/HydroDyn.f90 index 6fcf23a1b4..9f1b60fb8e 100644 --- a/modules/hydrodyn/src/HydroDyn.f90 +++ b/modules/hydrodyn/src/HydroDyn.f90 @@ -2158,7 +2158,7 @@ SUBROUTINE CheckError(ErrID,Msg) CHARACTER(*), INTENT(IN) :: Msg ! The error message (ErrMsg) INTEGER(IntKi) :: ErrStat3 ! The error identifier (ErrStat) - CHARACTER(1024) :: ErrMsg3 ! The error message (ErrMsg) + CHARACTER(ErrMsgLen) :: ErrMsg3 ! The error message (ErrMsg) !............................................................................................................................ ! Set error status/message; @@ -2229,7 +2229,6 @@ SUBROUTINE HD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM ErrStat = ErrID_None ErrMsg = '' - m%IgnoreMod = .true. ! to compute perturbations, we need to ignore the modulo function ! LIN_TODO: We need to deal with the case where either RdtnMod=0, and/or ExtcnMod=0 and hence %SS_Rdtn data or %SS_Exctn data is not valid NN = p%WAMIT%SS_Rdtn%N + p%WAMIT%SS_Exctn%N @@ -2365,7 +2364,6 @@ subroutine cleanup() call HydroDyn_DestroyContState( x_p, ErrStat2, ErrMsg2 ) call HydroDyn_DestroyContState( x_m, ErrStat2, ErrMsg2 ) call HydroDyn_DestroyInput( u_perturb, ErrStat2, ErrMsg2 ) - m%IgnoreMod = .false. end subroutine cleanup END SUBROUTINE HD_JacobianPInput @@ -2416,7 +2414,6 @@ SUBROUTINE HD_JacobianPContState( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrStat = ErrID_None ErrMsg = '' - m%IgnoreMod = .true. ! to get true perturbations, we can't use the modulo function ! Calculate the partial derivative of the output functions (Y) with respect to the continuous states (x) here: @@ -2540,7 +2537,6 @@ subroutine cleanup() call HydroDyn_DestroyContState( x_p, ErrStat2, ErrMsg2 ) call HydroDyn_DestroyContState( x_m, ErrStat2, ErrMsg2 ) call HydroDyn_DestroyContState(x_perturb, ErrStat2, ErrMsg2 ) - m%IgnoreMod = .false. end subroutine cleanup END SUBROUTINE HD_JacobianPContState @@ -3158,7 +3154,7 @@ SUBROUTINE HD_Perturb_x( p, n, perturb_sign, x, dx ) x%WAMIT%SS_Exctn%x( indx ) = x%WAMIT%SS_Exctn%x( indx ) + dx * perturb_sign end if - END SUBROUTINE HD_Perturb_x +END SUBROUTINE HD_Perturb_x !---------------------------------------------------------------------------------------------------------------------------------- !> This routine uses values of two output types to compute an array of differences. diff --git a/modules/hydrodyn/src/HydroDyn.txt b/modules/hydrodyn/src/HydroDyn.txt index 7d49e6d159..ca379172d8 100644 --- a/modules/hydrodyn/src/HydroDyn.txt +++ b/modules/hydrodyn/src/HydroDyn.txt @@ -1,4 +1,5 @@ ################################################################################################################################### +################################################################################################################################### # Registry for HydroDyn in the FAST Modularization Framework # This Registry file is used to create MODULE HydroDyn which contains all of the user-defined types needed in HydroDyn. # It also contains copy, destroy, pack, and unpack routines associated with each defined data types. @@ -154,7 +155,6 @@ typedef ^ ^ Morison_Mis typedef ^ ^ WAMIT_InputType u_WAMIT - - - "WAMIT module inputs" - typedef ^ ^ WAMIT2_InputType u_WAMIT2 - - - "WAMIT2 module inputs" - typedef ^ ^ Waves2_InputType u_Waves2 - - - "Waves2 module inputs" - -typedef ^ ^ Logical IgnoreMod - - - "whether to ignore the modulo in ED outputs (necessary for linearization perturbations)" - # ..... Parameters ................................................................................................................ # Define parameters here: # Time step for integration of continuous states (if a fixed-step integrator is used) and update of discrete states: @@ -182,7 +182,7 @@ typedef ^ ^ INTEGER typedef ^ ^ INTEGER OutSwtch - - - "Output requested channels to: [1=Hydrodyn.out 2=GlueCode.out 3=both files]" - typedef ^ ^ CHARACTER(20) OutFmt - - - "Output format for numerical results" - typedef ^ ^ CHARACTER(20) OutSFmt - - - "Output format for header strings" - -typedef ^ ^ CHARACTER(10) Delim - - - "Delimiter string for outputs, defaults to tab-delimiters" - +typedef ^ ^ CHARACTER(ChanLen) Delim - - - "Delimiter string for outputs, defaults to tab-delimiters" - typedef ^ ^ INTEGER UnOutFile - - - "File unit for the HydroDyn outputs" - typedef ^ ^ INTEGER OutDec - - - "Write every OutDec time steps" - typedef ^ ^ Integer Jac_u_indx {:}{:} - - "matrix to help fill/pack the u vector in computing the jacobian" - diff --git a/modules/hydrodyn/src/HydroDyn_DriverCode.f90 b/modules/hydrodyn/src/HydroDyn_DriverCode.f90 index faecab4896..09dc34dd3c 100644 --- a/modules/hydrodyn/src/HydroDyn_DriverCode.f90 +++ b/modules/hydrodyn/src/HydroDyn_DriverCode.f90 @@ -112,7 +112,6 @@ PROGRAM HydroDynDriver real(ReKi) :: PrevClockTime ! Clock time at start of simulation in seconds real(ReKi) :: UsrTime1 ! User CPU time for simulation initialization real(ReKi) :: UsrTime2 ! User CPU time for simulation (without intialization) - real(ReKi) :: UsrTimeDiff ! Difference in CPU time from start to finish of program execution real(DbKi) :: TiLstPrn ! The simulation time of the last print real(DbKi) :: t_global ! Current simulation time (for global/FAST simulation) real(DbKi) :: SttsTime ! Amount of time between screen status messages (sec) @@ -540,7 +539,7 @@ subroutine HD_DvrCleanup() end if ! Print *, time - call RunTimes( StrtTime, REAL(UsrTime1,ReKi), SimStrtTime, REAL(UsrTime2,ReKi), time, UsrTimeDiff ) + call RunTimes( StrtTime, REAL(UsrTime1,ReKi), SimStrtTime, REAL(UsrTime2,ReKi), time ) call NormStop() end subroutine HD_DvrCleanup diff --git a/modules/hydrodyn/src/HydroDyn_Input.f90 b/modules/hydrodyn/src/HydroDyn_Input.f90 index 83c5e1b773..b4042f2373 100644 --- a/modules/hydrodyn/src/HydroDyn_Input.f90 +++ b/modules/hydrodyn/src/HydroDyn_Input.f90 @@ -2475,7 +2475,11 @@ SUBROUTINE HydroDynInput_ProcessInitData( InitInp, ErrStat, ErrMsg ) ! TODO: Issue warning if WaveTMax was not already 0.0 in this case. IF ( .NOT. EqualRealNos(InitInp%Waves%WaveTMax, 0.0_DbKi) ) THEN CALL WrScr( ' Setting WaveTMax to 0.0 since WaveMod = 0' ) - InitInp%Waves%WaveTMax = 0.0 + InitInp%Waves%WaveTMax = 0.0 + END IF + IF ( .NOT. EqualRealNos(InitInp%Waves%WaveDir, 0.0_SiKi) ) THEN + CALL WrScr( ' Setting WaveDir to 0.0 since WaveMod = 0' ) + InitInp%Waves%WaveDir = 0.0 END IF ELSEIF ( InitInp%Waves%WaveMod == 5 ) THEN ! User wave elevation file reading in IF (InitInp%TMax > InitInp%Waves%WaveTMax ) THEN diff --git a/modules/hydrodyn/src/HydroDyn_Output.f90 b/modules/hydrodyn/src/HydroDyn_Output.f90 index 5d069ba599..ddd9db02fa 100644 --- a/modules/hydrodyn/src/HydroDyn_Output.f90 +++ b/modules/hydrodyn/src/HydroDyn_Output.f90 @@ -294,7 +294,7 @@ SUBROUTINE HDOut_WriteWvKinFiles( Rootname, HD_Prog, NStepWave, NNodes, NWaveEle CHARACTER(5) :: extension(7) INTEGER :: i, j, iFile CHARACTER(64) :: Frmt, Sfrmt - CHARACTER(10) :: Delim + CHARACTER(ChanLen) :: Delim ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" diff --git a/modules/hydrodyn/src/HydroDyn_Types.f90 b/modules/hydrodyn/src/HydroDyn_Types.f90 index a9c61fda9f..1b6b52b75c 100644 --- a/modules/hydrodyn/src/HydroDyn_Types.f90 +++ b/modules/hydrodyn/src/HydroDyn_Types.f90 @@ -172,7 +172,6 @@ MODULE HydroDyn_Types TYPE(WAMIT_InputType) :: u_WAMIT !< WAMIT module inputs [-] TYPE(WAMIT2_InputType) :: u_WAMIT2 !< WAMIT2 module inputs [-] TYPE(Waves2_InputType) :: u_Waves2 !< Waves2 module inputs [-] - LOGICAL :: IgnoreMod !< whether to ignore the modulo in ED outputs (necessary for linearization perturbations) [-] END TYPE HydroDyn_MiscVarType ! ======================= ! ========= HydroDyn_ParameterType ======= @@ -199,7 +198,7 @@ MODULE HydroDyn_Types INTEGER(IntKi) :: OutSwtch !< Output requested channels to: [1=Hydrodyn.out 2=GlueCode.out 3=both files] [-] CHARACTER(20) :: OutFmt !< Output format for numerical results [-] CHARACTER(20) :: OutSFmt !< Output format for header strings [-] - CHARACTER(10) :: Delim !< Delimiter string for outputs, defaults to tab-delimiters [-] + CHARACTER(ChanLen) :: Delim !< Delimiter string for outputs, defaults to tab-delimiters [-] INTEGER(IntKi) :: UnOutFile !< File unit for the HydroDyn outputs [-] INTEGER(IntKi) :: OutDec !< Write every OutDec time steps [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Jac_u_indx !< matrix to help fill/pack the u vector in computing the jacobian [-] @@ -562,26 +561,26 @@ SUBROUTINE HydroDyn_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%UseInputFile , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutRootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutRootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Linearize , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%TMax - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%HasIce , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%InputFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%UseInputFile, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%OutRootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutRootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%Linearize, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Gravity + Re_Xferred = Re_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%TMax + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%HasIce, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WaveElevXY) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -595,57 +594,75 @@ SUBROUTINE HydroDyn_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevXY,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElevXY)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElevXY))-1 ) = PACK(InData%WaveElevXY,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElevXY) + DO i2 = LBOUND(InData%WaveElevXY,2), UBOUND(InData%WaveElevXY,2) + DO i1 = LBOUND(InData%WaveElevXY,1), UBOUND(InData%WaveElevXY,1) + ReKiBuf(Re_Xferred) = InData%WaveElevXY(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmLocationX - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmLocationY - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%PtfmSgFChr) - IntKiBuf(Int_Xferred) = ICHAR(InData%PtfmSgFChr(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmSgF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%PtfmSwFChr) - IntKiBuf(Int_Xferred) = ICHAR(InData%PtfmSwFChr(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmSwF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%PtfmHvFChr) - IntKiBuf(Int_Xferred) = ICHAR(InData%PtfmHvFChr(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmHvF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%PtfmRFChr) - IntKiBuf(Int_Xferred) = ICHAR(InData%PtfmRFChr(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmRF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%PtfmPFChr) - IntKiBuf(Int_Xferred) = ICHAR(InData%PtfmPFChr(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmPF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%PtfmYFChr) - IntKiBuf(Int_Xferred) = ICHAR(InData%PtfmYFChr(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmYF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AddF0))-1 ) = PACK(InData%AddF0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AddF0) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AddCLin))-1 ) = PACK(InData%AddCLin,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AddCLin) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AddBLin))-1 ) = PACK(InData%AddBLin,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AddBLin) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AddBQuad))-1 ) = PACK(InData%AddBQuad,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AddBQuad) + ReKiBuf(Re_Xferred) = InData%PtfmLocationX + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmLocationY + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(InData%PtfmSgFChr) + IntKiBuf(Int_Xferred) = ICHAR(InData%PtfmSgFChr(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmSgF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%PtfmSwFChr) + IntKiBuf(Int_Xferred) = ICHAR(InData%PtfmSwFChr(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmSwF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%PtfmHvFChr) + IntKiBuf(Int_Xferred) = ICHAR(InData%PtfmHvFChr(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmHvF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%PtfmRFChr) + IntKiBuf(Int_Xferred) = ICHAR(InData%PtfmRFChr(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmRF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%PtfmPFChr) + IntKiBuf(Int_Xferred) = ICHAR(InData%PtfmPFChr(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmPF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%PtfmYFChr) + IntKiBuf(Int_Xferred) = ICHAR(InData%PtfmYFChr(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmYF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%AddF0,1), UBOUND(InData%AddF0,1) + ReKiBuf(Re_Xferred) = InData%AddF0(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i2 = LBOUND(InData%AddCLin,2), UBOUND(InData%AddCLin,2) + DO i1 = LBOUND(InData%AddCLin,1), UBOUND(InData%AddCLin,1) + ReKiBuf(Re_Xferred) = InData%AddCLin(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%AddBLin,2), UBOUND(InData%AddBLin,2) + DO i1 = LBOUND(InData%AddBLin,1), UBOUND(InData%AddBLin,1) + ReKiBuf(Re_Xferred) = InData%AddBLin(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%AddBQuad,2), UBOUND(InData%AddBQuad,2) + DO i1 = LBOUND(InData%AddBQuad,1), UBOUND(InData%AddBQuad,1) + ReKiBuf(Re_Xferred) = InData%AddBQuad(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO CALL Waves_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%Waves, ErrStat2, ErrMsg2, OnlySize ) ! Waves CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -730,10 +747,10 @@ SUBROUTINE HydroDyn_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - DO I = 1, LEN(InData%PotFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%PotFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(InData%PotFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%PotFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I CALL WAMIT_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT, ErrStat2, ErrMsg2, OnlySize ) ! WAMIT CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -818,12 +835,12 @@ SUBROUTINE HydroDyn_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Echo , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%PotMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NUserOutputs - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%Echo, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%PotMod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NUserOutputs + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%UserOutputs) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -834,37 +851,37 @@ SUBROUTINE HydroDyn_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UserOutputs,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%UserOutputs,1), UBOUND(InData%UserOutputs,1) + DO i1 = LBOUND(InData%UserOutputs,1), UBOUND(InData%UserOutputs,1) DO I = 1, LEN(InData%UserOutputs) IntKiBuf(Int_Xferred) = ICHAR(InData%UserOutputs(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%OutSwtch - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%OutAll , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%OutSwtch + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%OutAll, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) - DO I = 1, LEN(InData%OutList) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%HDSum , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UnSum - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%OutSFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutSFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(InData%OutList) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + IntKiBuf(Int_Xferred) = TRANSFER(InData%HDSum, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%UnSum + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%OutFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%OutSFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutSFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE HydroDyn_PackInitInput SUBROUTINE HydroDyn_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -880,12 +897,6 @@ SUBROUTINE HydroDyn_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -901,26 +912,26 @@ SUBROUTINE HydroDyn_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%InputFile) - OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%UseInputFile = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutRootName) - OutData%OutRootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%Linearize = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%Gravity = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMax = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%HasIce = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%InputFile) + OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%UseInputFile = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseInputFile) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%OutRootName) + OutData%OutRootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%Linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%Linearize) + Int_Xferred = Int_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%Gravity = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMax = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%HasIce = TRANSFER(IntKiBuf(Int_Xferred), OutData%HasIce) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevXY not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -937,106 +948,89 @@ SUBROUTINE HydroDyn_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevXY.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveElevXY)>0) OutData%WaveElevXY = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElevXY))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElevXY) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveElevXY,2), UBOUND(OutData%WaveElevXY,2) + DO i1 = LBOUND(OutData%WaveElevXY,1), UBOUND(OutData%WaveElevXY,1) + OutData%WaveElevXY(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - OutData%PtfmLocationX = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmLocationY = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%PtfmSgFChr) - OutData%PtfmSgFChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%PtfmSgF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%PtfmSwFChr) - OutData%PtfmSwFChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%PtfmSwF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%PtfmHvFChr) - OutData%PtfmHvFChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%PtfmHvF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%PtfmRFChr) - OutData%PtfmRFChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%PtfmRF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%PtfmPFChr) - OutData%PtfmPFChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%PtfmPF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%PtfmYFChr) - OutData%PtfmYFChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%PtfmYF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%PtfmLocationX = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmLocationY = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(OutData%PtfmSgFChr) + OutData%PtfmSgFChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%PtfmSgF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmSgF) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%PtfmSwFChr) + OutData%PtfmSwFChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%PtfmSwF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmSwF) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%PtfmHvFChr) + OutData%PtfmHvFChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%PtfmHvF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmHvF) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%PtfmRFChr) + OutData%PtfmRFChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%PtfmRF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmRF) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%PtfmPFChr) + OutData%PtfmPFChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%PtfmPF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmPF) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%PtfmYFChr) + OutData%PtfmYFChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%PtfmYF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmYF) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%AddF0,1) i1_u = UBOUND(OutData%AddF0,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%AddF0 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AddF0))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AddF0) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AddF0,1), UBOUND(OutData%AddF0,1) + OutData%AddF0(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%AddCLin,1) i1_u = UBOUND(OutData%AddCLin,1) i2_l = LBOUND(OutData%AddCLin,2) i2_u = UBOUND(OutData%AddCLin,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%AddCLin = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AddCLin))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AddCLin) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AddCLin,2), UBOUND(OutData%AddCLin,2) + DO i1 = LBOUND(OutData%AddCLin,1), UBOUND(OutData%AddCLin,1) + OutData%AddCLin(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%AddBLin,1) i1_u = UBOUND(OutData%AddBLin,1) i2_l = LBOUND(OutData%AddBLin,2) i2_u = UBOUND(OutData%AddBLin,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%AddBLin = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AddBLin))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AddBLin) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AddBLin,2), UBOUND(OutData%AddBLin,2) + DO i1 = LBOUND(OutData%AddBLin,1), UBOUND(OutData%AddBLin,1) + OutData%AddBLin(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%AddBQuad,1) i1_u = UBOUND(OutData%AddBQuad,1) i2_l = LBOUND(OutData%AddBQuad,2) i2_u = UBOUND(OutData%AddBQuad,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%AddBQuad = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AddBQuad))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AddBQuad) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AddBQuad,2), UBOUND(OutData%AddBQuad,2) + DO i1 = LBOUND(OutData%AddBQuad,1), UBOUND(OutData%AddBQuad,1) + OutData%AddBQuad(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -1157,10 +1151,10 @@ SUBROUTINE HydroDyn_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - DO I = 1, LEN(OutData%PotFile) - OutData%PotFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%PotFile) + OutData%PotFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -1281,12 +1275,12 @@ SUBROUTINE HydroDyn_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%Echo = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%PotMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NUserOutputs = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%Echo = TRANSFER(IntKiBuf(Int_Xferred), OutData%Echo) + Int_Xferred = Int_Xferred + 1 + OutData%PotMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NUserOutputs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UserOutputs not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1300,53 +1294,39 @@ SUBROUTINE HydroDyn_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UserOutputs.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%UserOutputs,1), UBOUND(OutData%UserOutputs,1) + DO i1 = LBOUND(OutData%UserOutputs,1), UBOUND(OutData%UserOutputs,1) DO I = 1, LEN(OutData%UserOutputs) OutData%UserOutputs(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF - OutData%OutSwtch = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%OutAll = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%OutSwtch = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%OutAll = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutAll) + Int_Xferred = Int_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%OutList,1) i1_u = UBOUND(OutData%OutList,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) - DO I = 1, LEN(OutData%OutList) - OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - DEALLOCATE(mask1) - OutData%HDSum = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%UnSum = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutFmt) - OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%OutSFmt) - OutData%OutSFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%OutList) + OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 END DO ! I + END DO + OutData%HDSum = TRANSFER(IntKiBuf(Int_Xferred), OutData%HDSum) + Int_Xferred = Int_Xferred + 1 + OutData%UnSum = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%OutFmt) + OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%OutSFmt) + OutData%OutSFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE HydroDyn_UnPackInitInput SUBROUTINE HydroDyn_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -1836,12 +1816,12 @@ SUBROUTINE HydroDyn_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1853,12 +1833,12 @@ SUBROUTINE HydroDyn_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveElevSeries) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1873,8 +1853,12 @@ SUBROUTINE HydroDyn_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevSeries,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElevSeries)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElevSeries))-1 ) = PACK(InData%WaveElevSeries,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElevSeries) + DO i2 = LBOUND(InData%WaveElevSeries,2), UBOUND(InData%WaveElevSeries,2) + DO i1 = LBOUND(InData%WaveElevSeries,1), UBOUND(InData%WaveElevSeries,1) + ReKiBuf(Re_Xferred) = InData%WaveElevSeries(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1904,12 +1888,12 @@ SUBROUTINE HydroDyn_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WtrDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MSL2SWL - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDens + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDpth + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MSL2SWL + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%LinNames_y) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1920,12 +1904,12 @@ SUBROUTINE HydroDyn_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_y,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%LinNames_y,1), UBOUND(InData%LinNames_y,1) + DO 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LinNames_x) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1937,12 +1921,12 @@ SUBROUTINE HydroDyn_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_x,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%LinNames_x,1), UBOUND(InData%LinNames_x,1) + DO 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LinNames_u) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1954,12 +1938,12 @@ SUBROUTINE HydroDyn_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_u,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%LinNames_u,1), UBOUND(InData%LinNames_u,1) + DO 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%DerivOrder_x) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1971,8 +1955,10 @@ SUBROUTINE HydroDyn_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DerivOrder_x,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DerivOrder_x)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%DerivOrder_x))-1 ) = PACK(InData%DerivOrder_x,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%DerivOrder_x) + DO i1 = LBOUND(InData%DerivOrder_x,1), UBOUND(InData%DerivOrder_x,1) + IntKiBuf(Int_Xferred) = InData%DerivOrder_x(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%IsLoad_u) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1984,8 +1970,10 @@ SUBROUTINE HydroDyn_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IsLoad_u,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%IsLoad_u)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%IsLoad_u)-1 ) = TRANSFER(PACK( InData%IsLoad_u ,.TRUE.), IntKiBuf(1), SIZE(InData%IsLoad_u)) - Int_Xferred = Int_Xferred + SIZE(InData%IsLoad_u) + DO i1 = LBOUND(InData%IsLoad_u,1), UBOUND(InData%IsLoad_u,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%IsLoad_u(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF END SUBROUTINE HydroDyn_PackInitOutput @@ -2002,12 +1990,6 @@ SUBROUTINE HydroDyn_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -2196,19 +2178,12 @@ SUBROUTINE HydroDyn_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated Int_Xferred = Int_Xferred + 1 @@ -2223,19 +2198,12 @@ SUBROUTINE HydroDyn_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevSeries not allocated Int_Xferred = Int_Xferred + 1 @@ -2253,15 +2221,12 @@ SUBROUTINE HydroDyn_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevSeries.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveElevSeries)>0) OutData%WaveElevSeries = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElevSeries))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElevSeries) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveElevSeries,2), UBOUND(OutData%WaveElevSeries,2) + DO i1 = LBOUND(OutData%WaveElevSeries,1), UBOUND(OutData%WaveElevSeries,1) + OutData%WaveElevSeries(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -2303,12 +2268,12 @@ SUBROUTINE HydroDyn_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%WtrDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDpth = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MSL2SWL = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%WtrDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WtrDpth = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MSL2SWL = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_y not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -2322,19 +2287,12 @@ SUBROUTINE HydroDyn_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%LinNames_y,1), UBOUND(OutData%LinNames_y,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_x not allocated Int_Xferred = Int_Xferred + 1 @@ -2349,19 +2307,12 @@ SUBROUTINE HydroDyn_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_x.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%LinNames_x,1), UBOUND(OutData%LinNames_x,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_u not allocated Int_Xferred = Int_Xferred + 1 @@ -2376,19 +2327,12 @@ SUBROUTINE HydroDyn_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%LinNames_u,1), UBOUND(OutData%LinNames_u,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DerivOrder_x not allocated Int_Xferred = Int_Xferred + 1 @@ -2403,15 +2347,10 @@ SUBROUTINE HydroDyn_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%DerivOrder_x)>0) OutData%DerivOrder_x = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%DerivOrder_x))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%DerivOrder_x) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%DerivOrder_x,1), UBOUND(OutData%DerivOrder_x,1) + OutData%DerivOrder_x(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IsLoad_u not allocated Int_Xferred = Int_Xferred + 1 @@ -2426,15 +2365,10 @@ SUBROUTINE HydroDyn_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%IsLoad_u)>0) OutData%IsLoad_u = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%IsLoad_u))-1 ), OutData%IsLoad_u), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%IsLoad_u) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%IsLoad_u,1), UBOUND(OutData%IsLoad_u,1) + OutData%IsLoad_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsLoad_u(i1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF END SUBROUTINE HydroDyn_UnPackInitOutput @@ -2690,12 +2624,6 @@ SUBROUTINE HydroDyn_UnPackHD_ModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_UnPackHD_ModuleMapType' @@ -3132,12 +3060,6 @@ SUBROUTINE HydroDyn_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_UnPackContState' @@ -3614,12 +3536,6 @@ SUBROUTINE HydroDyn_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_UnPackDiscState' @@ -4096,12 +4012,6 @@ SUBROUTINE HydroDyn_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_UnPackConstrState' @@ -4578,12 +4488,6 @@ SUBROUTINE HydroDyn_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_UnPackOtherState' @@ -4816,7 +4720,6 @@ SUBROUTINE HydroDyn_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMs CALL Waves2_CopyInput( SrcMiscData%u_Waves2, DstMiscData%u_Waves2, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - DstMiscData%IgnoreMod = SrcMiscData%IgnoreMod END SUBROUTINE HydroDyn_CopyMisc SUBROUTINE HydroDyn_DestroyMisc( MiscData, ErrStat, ErrMsg ) @@ -5088,7 +4991,6 @@ SUBROUTINE HydroDyn_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF - Int_BufSz = Int_BufSz + 1 ! IgnoreMod IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -5256,18 +5158,24 @@ SUBROUTINE HydroDyn_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Decimate - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%LastOutTime - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%LastIndWave - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F_PtfmAdd))-1 ) = PACK(InData%F_PtfmAdd,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F_PtfmAdd) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F_Hydro))-1 ) = PACK(InData%F_Hydro,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F_Hydro) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F_Waves))-1 ) = PACK(InData%F_Waves,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F_Waves) + IntKiBuf(Int_Xferred) = InData%Decimate + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%LastOutTime + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%LastIndWave + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%F_PtfmAdd,1), UBOUND(InData%F_PtfmAdd,1) + ReKiBuf(Re_Xferred) = InData%F_PtfmAdd(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%F_Hydro,1), UBOUND(InData%F_Hydro,1) + ReKiBuf(Re_Xferred) = InData%F_Hydro(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%F_Waves,1), UBOUND(InData%F_Waves,1) + ReKiBuf(Re_Xferred) = InData%F_Waves(i1) + Re_Xferred = Re_Xferred + 1 + END DO CALL WAMIT_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%WAMIT, ErrStat2, ErrMsg2, OnlySize ) ! WAMIT CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -5464,8 +5372,6 @@ SUBROUTINE HydroDyn_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%IgnoreMod , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 END SUBROUTINE HydroDyn_PackMisc SUBROUTINE HydroDyn_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -5481,12 +5387,6 @@ SUBROUTINE HydroDyn_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -5701,45 +5601,30 @@ SUBROUTINE HydroDyn_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%Decimate = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%LastOutTime = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%LastIndWave = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%Decimate = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%LastOutTime = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%LastIndWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%F_PtfmAdd,1) i1_u = UBOUND(OutData%F_PtfmAdd,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%F_PtfmAdd = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F_PtfmAdd))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F_PtfmAdd) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%F_PtfmAdd,1), UBOUND(OutData%F_PtfmAdd,1) + OutData%F_PtfmAdd(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%F_Hydro,1) i1_u = UBOUND(OutData%F_Hydro,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%F_Hydro = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F_Hydro))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F_Hydro) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%F_Hydro,1), UBOUND(OutData%F_Hydro,1) + OutData%F_Hydro(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%F_Waves,1) i1_u = UBOUND(OutData%F_Waves,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%F_Waves = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F_Waves))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F_Waves) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%F_Waves,1), UBOUND(OutData%F_Waves,1) + OutData%F_Waves(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -6020,8 +5905,6 @@ SUBROUTINE HydroDyn_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%IgnoreMod = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 END SUBROUTINE HydroDyn_UnPackMisc SUBROUTINE HydroDyn_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -6519,8 +6402,8 @@ SUBROUTINE HydroDyn_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%PotMod - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%PotMod + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WaveTime) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -6531,13 +6414,15 @@ SUBROUTINE HydroDyn_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveTime)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveTime))-1 ) = PACK(InData%WaveTime,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveTime) + DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) + ReKiBuf(Re_Xferred) = InData%WaveTime(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NWaveElev - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepWave + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NWaveElev + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WaveElev) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -6551,8 +6436,12 @@ SUBROUTINE HydroDyn_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElev)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElev))-1 ) = PACK(InData%WaveElev,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElev) + DO i2 = LBOUND(InData%WaveElev,2), UBOUND(InData%WaveElev,2) + DO i1 = LBOUND(InData%WaveElev,1), UBOUND(InData%WaveElev,1) + ReKiBuf(Re_Xferred) = InData%WaveElev(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveElev1) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6567,21 +6456,39 @@ SUBROUTINE HydroDyn_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev1,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElev1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElev1))-1 ) = PACK(InData%WaveElev1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElev1) + DO i2 = LBOUND(InData%WaveElev1,2), UBOUND(InData%WaveElev1,2) + DO i1 = LBOUND(InData%WaveElev1,1), UBOUND(InData%WaveElev1,1) + ReKiBuf(Re_Xferred) = InData%WaveElev1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AddF0))-1 ) = PACK(InData%AddF0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AddF0) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AddCLin))-1 ) = PACK(InData%AddCLin,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AddCLin) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AddBLin))-1 ) = PACK(InData%AddBLin,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AddBLin) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AddBQuad))-1 ) = PACK(InData%AddBQuad,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AddBQuad) - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDpth + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%AddF0,1), UBOUND(InData%AddF0,1) + ReKiBuf(Re_Xferred) = InData%AddF0(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i2 = LBOUND(InData%AddCLin,2), UBOUND(InData%AddCLin,2) + DO i1 = LBOUND(InData%AddCLin,1), UBOUND(InData%AddCLin,1) + ReKiBuf(Re_Xferred) = InData%AddCLin(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%AddBLin,2), UBOUND(InData%AddBLin,2) + DO i1 = LBOUND(InData%AddBLin,1), UBOUND(InData%AddBLin,1) + ReKiBuf(Re_Xferred) = InData%AddBLin(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%AddBQuad,2), UBOUND(InData%AddBQuad,2) + DO i1 = LBOUND(InData%AddBQuad,1), UBOUND(InData%AddBQuad,1) + ReKiBuf(Re_Xferred) = InData%AddBQuad(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 IF ( .NOT. ALLOCATED(InData%OutParam) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -6623,28 +6530,28 @@ SUBROUTINE HydroDyn_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM ENDIF END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumTotalOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%OutSwtch - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%OutSFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutSFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%Delim) - IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UnOutFile - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%OutDec - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumTotalOuts + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%OutSwtch + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%OutFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%OutSFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutSFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%Delim) + IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%UnOutFile + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%OutDec + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%Jac_u_indx) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -6658,8 +6565,12 @@ SUBROUTINE HydroDyn_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Jac_u_indx)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%Jac_u_indx))-1 ) = PACK(InData%Jac_u_indx,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%Jac_u_indx) + DO i2 = LBOUND(InData%Jac_u_indx,2), UBOUND(InData%Jac_u_indx,2) + DO i1 = LBOUND(InData%Jac_u_indx,1), UBOUND(InData%Jac_u_indx,1) + IntKiBuf(Int_Xferred) = InData%Jac_u_indx(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%du) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6671,8 +6582,10 @@ SUBROUTINE HydroDyn_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%du,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%du)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%du))-1 ) = PACK(InData%du,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%du) + DO i1 = LBOUND(InData%du,1), UBOUND(InData%du,1) + DbKiBuf(Db_Xferred) = InData%du(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%dx) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6684,11 +6597,13 @@ SUBROUTINE HydroDyn_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%dx,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%dx)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%dx))-1 ) = PACK(InData%dx,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%dx) + DO i1 = LBOUND(InData%dx,1), UBOUND(InData%dx,1) + DbKiBuf(Db_Xferred) = InData%dx(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Jac_ny - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Jac_ny + Int_Xferred = Int_Xferred + 1 END SUBROUTINE HydroDyn_PackParam SUBROUTINE HydroDyn_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -6704,12 +6619,6 @@ SUBROUTINE HydroDyn_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -6885,8 +6794,8 @@ SUBROUTINE HydroDyn_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%PotMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%PotMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -6900,20 +6809,15 @@ SUBROUTINE HydroDyn_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveTime)>0) OutData%WaveTime = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveTime))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveTime) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) + OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%NStepWave = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NWaveElev = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NStepWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NWaveElev = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -6930,15 +6834,12 @@ SUBROUTINE HydroDyn_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveElev)>0) OutData%WaveElev = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElev))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElev) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveElev,2), UBOUND(OutData%WaveElev,2) + DO i1 = LBOUND(OutData%WaveElev,1), UBOUND(OutData%WaveElev,1) + OutData%WaveElev(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev1 not allocated Int_Xferred = Int_Xferred + 1 @@ -6956,70 +6857,53 @@ SUBROUTINE HydroDyn_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveElev1)>0) OutData%WaveElev1 = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElev1))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElev1) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveElev1,2), UBOUND(OutData%WaveElev1,2) + DO i1 = LBOUND(OutData%WaveElev1,1), UBOUND(OutData%WaveElev1,1) + OutData%WaveElev1(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - OutData%WtrDpth = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%WtrDpth = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%AddF0,1) i1_u = UBOUND(OutData%AddF0,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%AddF0 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AddF0))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AddF0) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AddF0,1), UBOUND(OutData%AddF0,1) + OutData%AddF0(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%AddCLin,1) i1_u = UBOUND(OutData%AddCLin,1) i2_l = LBOUND(OutData%AddCLin,2) i2_u = UBOUND(OutData%AddCLin,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%AddCLin = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AddCLin))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AddCLin) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AddCLin,2), UBOUND(OutData%AddCLin,2) + DO i1 = LBOUND(OutData%AddCLin,1), UBOUND(OutData%AddCLin,1) + OutData%AddCLin(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%AddBLin,1) i1_u = UBOUND(OutData%AddBLin,1) i2_l = LBOUND(OutData%AddBLin,2) i2_u = UBOUND(OutData%AddBLin,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%AddBLin = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AddBLin))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AddBLin) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AddBLin,2), UBOUND(OutData%AddBLin,2) + DO i1 = LBOUND(OutData%AddBLin,1), UBOUND(OutData%AddBLin,1) + OutData%AddBLin(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%AddBQuad,1) i1_u = UBOUND(OutData%AddBQuad,1) i2_l = LBOUND(OutData%AddBQuad,2) i2_u = UBOUND(OutData%AddBQuad,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%AddBQuad = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AddBQuad))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AddBQuad) - DEALLOCATE(mask2) - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + DO i2 = LBOUND(OutData%AddBQuad,2), UBOUND(OutData%AddBQuad,2) + DO i1 = LBOUND(OutData%AddBQuad,1), UBOUND(OutData%AddBQuad,1) + OutData%AddBQuad(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParam not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -7076,28 +6960,28 @@ SUBROUTINE HydroDyn_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumTotalOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%OutSwtch = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutFmt) - OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%OutSFmt) - OutData%OutSFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Delim) - OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%UnOutFile = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%OutDec = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumTotalOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%OutSwtch = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%OutFmt) + OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%OutSFmt) + OutData%OutSFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%Delim) + OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%UnOutFile = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%OutDec = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_u_indx not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -7114,15 +6998,12 @@ SUBROUTINE HydroDyn_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Jac_u_indx)>0) OutData%Jac_u_indx = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%Jac_u_indx))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%Jac_u_indx) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Jac_u_indx,2), UBOUND(OutData%Jac_u_indx,2) + DO i1 = LBOUND(OutData%Jac_u_indx,1), UBOUND(OutData%Jac_u_indx,1) + OutData%Jac_u_indx(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! du not allocated Int_Xferred = Int_Xferred + 1 @@ -7137,15 +7018,10 @@ SUBROUTINE HydroDyn_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%du.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%du)>0) OutData%du = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%du))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%du) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%du,1), UBOUND(OutData%du,1) + OutData%du(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! dx not allocated Int_Xferred = Int_Xferred + 1 @@ -7160,18 +7036,13 @@ SUBROUTINE HydroDyn_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%dx.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%dx)>0) OutData%dx = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%dx))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%dx) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%dx,1), UBOUND(OutData%dx,1) + OutData%dx(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO END IF - OutData%Jac_ny = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%Jac_ny = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE HydroDyn_UnPackParam SUBROUTINE HydroDyn_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -7377,12 +7248,6 @@ SUBROUTINE HydroDyn_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_UnPackInput' @@ -7893,8 +7758,10 @@ SUBROUTINE HydroDyn_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WriteOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WriteOutput))-1 ) = PACK(InData%WriteOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WriteOutput) + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE HydroDyn_PackOutput @@ -7911,12 +7778,6 @@ SUBROUTINE HydroDyn_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -8184,15 +8045,10 @@ SUBROUTINE HydroDyn_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WriteOutput)>0) OutData%WriteOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WriteOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WriteOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE HydroDyn_UnPackOutput @@ -8271,8 +8127,8 @@ SUBROUTINE HydroDyn_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, Er REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -8287,6 +8143,8 @@ SUBROUTINE HydroDyn_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL Morison_Input_ExtrapInterp1( u1%Morison, u2%Morison, tin, u_out%Morison, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL MeshExtrapInterp1(u1%Mesh, u2%Mesh, tin, u_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) @@ -8320,8 +8178,9 @@ SUBROUTINE HydroDyn_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_Input_ExtrapInterp2' @@ -8343,6 +8202,8 @@ SUBROUTINE HydroDyn_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL Morison_Input_ExtrapInterp2( u1%Morison, u2%Morison, u3%Morison, tin, u_out%Morison, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL MeshExtrapInterp2(u1%Mesh, u2%Mesh, u3%Mesh, tin, u_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) @@ -8424,12 +8285,12 @@ SUBROUTINE HydroDyn_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, E REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -8442,6 +8303,8 @@ SUBROUTINE HydroDyn_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, E CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL WAMIT_Output_ExtrapInterp1( y1%WAMIT, y2%WAMIT, tin, y_out%WAMIT, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL WAMIT2_Output_ExtrapInterp1( y1%WAMIT2, y2%WAMIT2, tin, y_out%WAMIT2, tin_out, ErrStat2, ErrMsg2 ) @@ -8455,12 +8318,10 @@ SUBROUTINE HydroDyn_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, E CALL MeshExtrapInterp1(y1%AllHdroOrigin, y2%AllHdroOrigin, tin, y_out%AllHdroOrigin, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = -(y1%WriteOutput - y2%WriteOutput)/t(2) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO END IF ! check if allocated END SUBROUTINE HydroDyn_Output_ExtrapInterp1 @@ -8491,13 +8352,14 @@ SUBROUTINE HydroDyn_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrSta REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'HydroDyn_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -8516,6 +8378,8 @@ SUBROUTINE HydroDyn_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrSta CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL WAMIT_Output_ExtrapInterp2( y1%WAMIT, y2%WAMIT, y3%WAMIT, tin, y_out%WAMIT, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL WAMIT2_Output_ExtrapInterp2( y1%WAMIT2, y2%WAMIT2, y3%WAMIT2, tin, y_out%WAMIT2, tin_out, ErrStat2, ErrMsg2 ) @@ -8529,13 +8393,11 @@ SUBROUTINE HydroDyn_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrSta CALL MeshExtrapInterp2(y1%AllHdroOrigin, y2%AllHdroOrigin, y3%AllHdroOrigin, tin, y_out%AllHdroOrigin, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = (t(3)**2*(y1%WriteOutput - y2%WriteOutput) + t(2)**2*(-y1%WriteOutput + y3%WriteOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WriteOutput + t(3)*y2%WriteOutput - t(2)*y3%WriteOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO END IF ! check if allocated END SUBROUTINE HydroDyn_Output_ExtrapInterp2 diff --git a/modules/hydrodyn/src/Morison.f90 b/modules/hydrodyn/src/Morison.f90 index 5e051600a1..c0fdc4b52e 100644 --- a/modules/hydrodyn/src/Morison.f90 +++ b/modules/hydrodyn/src/Morison.f90 @@ -1020,7 +1020,7 @@ SUBROUTINE WriteSummaryFile( UnSum, MSL2SWL, WtrDpth, numNodes, nodes, numElemen REAL(ReKi) :: l ! length of an element LOGICAL :: filledFlag ! flag indicating if element is filled/flooded CHARACTER(2) :: strFmt - CHARACTER(10) :: strNodeType ! string indicating type of node: End, Interior, Super + CHARACTER(ChanLen) :: strNodeType ! string indicating type of node: End, Interior, Super REAL(ReKi) :: ident(3,3) ! identity matrix REAL(ReKi) :: ExtBuoyancy(6) ! sum of all external buoyancy forces lumped at (0,0,0) REAL(ReKi) :: IntBuoyancy(6) ! sum of all internal buoyancy forces lumped at (0,0,0) @@ -1041,7 +1041,7 @@ SUBROUTINE WriteSummaryFile( UnSum, MSL2SWL, WtrDpth, numNodes, nodes, numElemen REAL(ReKi) :: s ! The linear interpolation factor for the requested location REAL(ReKi) :: outloc(3) ! Position of the requested member output INTEGER :: mbrIndx, nodeIndx - CHARACTER(10) :: tmpName + CHARACTER(ChanLen) :: tmpName REAL(ReKi) :: totalFillMass, mass_fill, fillVol REAL(ReKi) :: totalMGMass, mass_MG TYPE(Morison_NodeType) :: node1, node2 diff --git a/modules/hydrodyn/src/Morison.txt b/modules/hydrodyn/src/Morison.txt index 0549599942..5326fb452c 100644 --- a/modules/hydrodyn/src/Morison.txt +++ b/modules/hydrodyn/src/Morison.txt @@ -339,7 +339,7 @@ typedef ^ ^ INTEGER typedef ^ ^ INTEGER UnOutFile - - - "" - typedef ^ ^ CHARACTER(20) OutFmt - - - "" - typedef ^ ^ CHARACTER(20) OutSFmt - - - "" - -typedef ^ ^ CHARACTER(10) Delim - - - "" - +typedef ^ ^ CHARACTER(ChanLen) Delim - - - "" - # # # ..... Inputs .................................................................................................................... diff --git a/modules/hydrodyn/src/Morison_Output.f90 b/modules/hydrodyn/src/Morison_Output.f90 index dba8a047f0..f859a3a556 100644 --- a/modules/hydrodyn/src/Morison_Output.f90 +++ b/modules/hydrodyn/src/Morison_Output.f90 @@ -7327,7 +7327,7 @@ SUBROUTINE MrsnOut_Init( InitInp, y, p, InitOut, ErrStat, ErrMsg ) IF ( InitInp%OutAll ) THEN ! p%NumOutAll = InitInp%NMember*2*22 + InitInp%NJoints*19 - p%NumOutAll = 0 + p%NumOutAll = 0 ELSE p%NumOutAll = 0 END IF diff --git a/modules/hydrodyn/src/Morison_Types.f90 b/modules/hydrodyn/src/Morison_Types.f90 index baa9d27f7f..5a0989fc09 100644 --- a/modules/hydrodyn/src/Morison_Types.f90 +++ b/modules/hydrodyn/src/Morison_Types.f90 @@ -396,7 +396,7 @@ MODULE Morison_Types INTEGER(IntKi) :: UnOutFile !< [-] CHARACTER(20) :: OutFmt !< [-] CHARACTER(20) :: OutSFmt !< [-] - CHARACTER(10) :: Delim !< [-] + CHARACTER(ChanLen) :: Delim !< [-] END TYPE Morison_ParameterType ! ======================= ! ========= Morison_InputType ======= @@ -519,20 +519,24 @@ SUBROUTINE Morison_PackJointType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%JointID - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%JointPos))-1 ) = PACK(InData%JointPos,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%JointPos) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%JointAxID - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%JointAxIDIndx - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%JointOvrlp - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NConnections - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%ConnectionList))-1 ) = PACK(InData%ConnectionList,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%ConnectionList) + IntKiBuf(Int_Xferred) = InData%JointID + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%JointPos,1), UBOUND(InData%JointPos,1) + ReKiBuf(Re_Xferred) = InData%JointPos(i1) + Re_Xferred = Re_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%JointAxID + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%JointAxIDIndx + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%JointOvrlp + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NConnections + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%ConnectionList,1), UBOUND(InData%ConnectionList,1) + IntKiBuf(Int_Xferred) = InData%ConnectionList(i1) + Int_Xferred = Int_Xferred + 1 + END DO END SUBROUTINE Morison_PackJointType SUBROUTINE Morison_UnPackJointType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -548,12 +552,6 @@ SUBROUTINE Morison_UnPackJointType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (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 @@ -570,38 +568,28 @@ SUBROUTINE Morison_UnPackJointType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%JointID = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%JointID = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%JointPos,1) i1_u = UBOUND(OutData%JointPos,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%JointPos = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%JointPos))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%JointPos) - DEALLOCATE(mask1) - OutData%JointAxID = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%JointAxIDIndx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%JointOvrlp = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NConnections = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%JointPos,1), UBOUND(OutData%JointPos,1) + OutData%JointPos(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%JointAxID = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%JointAxIDIndx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%JointOvrlp = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NConnections = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%ConnectionList,1) i1_u = UBOUND(OutData%ConnectionList,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%ConnectionList = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%ConnectionList))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%ConnectionList) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%ConnectionList,1), UBOUND(OutData%ConnectionList,1) + OutData%ConnectionList(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END SUBROUTINE Morison_UnPackJointType SUBROUTINE Morison_CopyMemberPropType( SrcMemberPropTypeData, DstMemberPropTypeData, CtrlCode, ErrStat, ErrMsg ) @@ -699,12 +687,12 @@ SUBROUTINE Morison_PackMemberPropType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%PropSetID - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PropD - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PropThck - Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%PropSetID + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PropD + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PropThck + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Morison_PackMemberPropType SUBROUTINE Morison_UnPackMemberPropType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -720,12 +708,6 @@ SUBROUTINE Morison_UnPackMemberPropType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Morison_UnPackMemberPropType' @@ -739,12 +721,12 @@ SUBROUTINE Morison_UnPackMemberPropType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%PropSetID = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%PropD = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PropThck = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%PropSetID = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%PropD = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PropThck = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Morison_UnPackMemberPropType SUBROUTINE Morison_CopyFilledGroupType( SrcFilledGroupTypeData, DstFilledGroupTypeData, CtrlCode, ErrStat, ErrMsg ) @@ -865,8 +847,8 @@ SUBROUTINE Morison_PackFilledGroupType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrS Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%FillNumM - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%FillNumM + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%FillMList) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -877,17 +859,19 @@ SUBROUTINE Morison_PackFilledGroupType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrS IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FillMList,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FillMList)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%FillMList))-1 ) = PACK(InData%FillMList,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%FillMList) + DO i1 = LBOUND(InData%FillMList,1), UBOUND(InData%FillMList,1) + IntKiBuf(Int_Xferred) = InData%FillMList(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%FillFSLoc - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%FillDensChr) - IntKiBuf(Int_Xferred) = ICHAR(InData%FillDensChr(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%FillDens - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FillFSLoc + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(InData%FillDensChr) + IntKiBuf(Int_Xferred) = ICHAR(InData%FillDensChr(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + ReKiBuf(Re_Xferred) = InData%FillDens + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Morison_PackFilledGroupType SUBROUTINE Morison_UnPackFilledGroupType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -903,12 +887,6 @@ SUBROUTINE Morison_UnPackFilledGroupType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -923,8 +901,8 @@ SUBROUTINE Morison_UnPackFilledGroupType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%FillNumM = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%FillNumM = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FillMList not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -938,24 +916,19 @@ SUBROUTINE Morison_UnPackFilledGroupType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FillMList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%FillMList)>0) OutData%FillMList = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%FillMList))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%FillMList) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FillMList,1), UBOUND(OutData%FillMList,1) + OutData%FillMList(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF - OutData%FillFSLoc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%FillDensChr) - OutData%FillDensChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%FillDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%FillFSLoc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(OutData%FillDensChr) + OutData%FillDensChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%FillDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Morison_UnPackFilledGroupType SUBROUTINE Morison_CopyCoefDpths( SrcCoefDpthsData, DstCoefDpthsData, CtrlCode, ErrStat, ErrMsg ) @@ -1069,28 +1042,28 @@ SUBROUTINE Morison_PackCoefDpths( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Dpth - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DpthCd - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DpthCdMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DpthCa - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DpthCaMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DpthCp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DpthCpMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DpthAxCa - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DpthAxCaMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DpthAxCp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DpthAxCpMG - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Dpth + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DpthCd + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DpthCdMG + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DpthCa + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DpthCaMG + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DpthCp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DpthCpMG + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DpthAxCa + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DpthAxCaMG + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DpthAxCp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DpthAxCpMG + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Morison_PackCoefDpths SUBROUTINE Morison_UnPackCoefDpths( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1106,12 +1079,6 @@ SUBROUTINE Morison_UnPackCoefDpths( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Morison_UnPackCoefDpths' @@ -1125,28 +1092,28 @@ SUBROUTINE Morison_UnPackCoefDpths( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%Dpth = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%DpthCd = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%DpthCdMG = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%DpthCa = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%DpthCaMG = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%DpthCp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%DpthCpMG = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%DpthAxCa = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%DpthAxCaMG = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%DpthAxCp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%DpthAxCpMG = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%Dpth = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%DpthCd = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%DpthCdMG = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%DpthCa = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%DpthCaMG = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%DpthCp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%DpthCpMG = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%DpthAxCa = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%DpthAxCaMG = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%DpthAxCp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%DpthAxCpMG = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Morison_UnPackCoefDpths SUBROUTINE Morison_CopyAxialCoefType( SrcAxialCoefTypeData, DstAxialCoefTypeData, CtrlCode, ErrStat, ErrMsg ) @@ -1246,14 +1213,14 @@ SUBROUTINE Morison_PackAxialCoefType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%AxCoefID - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AxCd - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AxCa - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AxCp - Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%AxCoefID + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AxCd + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AxCa + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AxCp + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Morison_PackAxialCoefType SUBROUTINE Morison_UnPackAxialCoefType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1269,12 +1236,6 @@ SUBROUTINE Morison_UnPackAxialCoefType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Morison_UnPackAxialCoefType' @@ -1288,14 +1249,14 @@ SUBROUTINE Morison_UnPackAxialCoefType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%AxCoefID = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%AxCd = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%AxCa = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%AxCp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%AxCoefID = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%AxCd = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%AxCa = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%AxCp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Morison_UnPackAxialCoefType SUBROUTINE Morison_CopyMemberInputType( SrcMemberInputTypeData, DstMemberInputTypeData, CtrlCode, ErrStat, ErrMsg ) @@ -1423,40 +1384,46 @@ SUBROUTINE Morison_PackMemberInputType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrS Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MemberID - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MJointID1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MJointID2 - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MJointID1Indx - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MJointID2Indx - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MPropSetID1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MPropSetID2 - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MPropSetID1Indx - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MPropSetID2Indx - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MDivSize - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MCoefMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MmbrCoefIDIndx - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MmbrFilledIDIndx - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PropPot , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumSplits - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Splits))-1 ) = PACK(InData%Splits,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Splits) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%R_LToG))-1 ) = PACK(InData%R_LToG,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%R_LToG) + IntKiBuf(Int_Xferred) = InData%MemberID + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MJointID1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MJointID2 + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MJointID1Indx + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MJointID2Indx + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MPropSetID1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MPropSetID2 + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MPropSetID1Indx + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MPropSetID2Indx + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MDivSize + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MCoefMod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MmbrCoefIDIndx + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MmbrFilledIDIndx + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%PropPot, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumSplits + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%Splits,1), UBOUND(InData%Splits,1) + ReKiBuf(Re_Xferred) = InData%Splits(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i2 = LBOUND(InData%R_LToG,2), UBOUND(InData%R_LToG,2) + DO i1 = LBOUND(InData%R_LToG,1), UBOUND(InData%R_LToG,1) + ReKiBuf(Re_Xferred) = InData%R_LToG(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END SUBROUTINE Morison_PackMemberInputType SUBROUTINE Morison_UnPackMemberInputType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1472,12 +1439,6 @@ SUBROUTINE Morison_UnPackMemberInputType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -1493,60 +1454,52 @@ SUBROUTINE Morison_UnPackMemberInputType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%MemberID = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%MJointID1 = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%MJointID2 = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%MJointID1Indx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%MJointID2Indx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%MPropSetID1 = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%MPropSetID2 = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%MPropSetID1Indx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%MPropSetID2Indx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%MDivSize = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MCoefMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%MmbrCoefIDIndx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%MmbrFilledIDIndx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%PropPot = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NumSplits = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%MemberID = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%MJointID1 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%MJointID2 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%MJointID1Indx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%MJointID2Indx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%MPropSetID1 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%MPropSetID2 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%MPropSetID1Indx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%MPropSetID2Indx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%MDivSize = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MCoefMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%MmbrCoefIDIndx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%MmbrFilledIDIndx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%PropPot = TRANSFER(IntKiBuf(Int_Xferred), OutData%PropPot) + Int_Xferred = Int_Xferred + 1 + OutData%NumSplits = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%Splits,1) i1_u = UBOUND(OutData%Splits,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%Splits = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Splits))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Splits) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Splits,1), UBOUND(OutData%Splits,1) + OutData%Splits(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%R_LToG,1) i1_u = UBOUND(OutData%R_LToG,1) i2_l = LBOUND(OutData%R_LToG,2) i2_u = UBOUND(OutData%R_LToG,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%R_LToG = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%R_LToG))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%R_LToG) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%R_LToG,2), UBOUND(OutData%R_LToG,2) + DO i1 = LBOUND(OutData%R_LToG,1), UBOUND(OutData%R_LToG,1) + OutData%R_LToG(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END SUBROUTINE Morison_UnPackMemberInputType SUBROUTINE Morison_CopyNodeType( SrcNodeTypeData, DstNodeTypeData, CtrlCode, ErrStat, ErrMsg ) @@ -1706,72 +1659,80 @@ SUBROUTINE Morison_PackNodeType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NodeType - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%JointIndx - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%JointPos))-1 ) = PACK(InData%JointPos,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%JointPos) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%JointOvrlp - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%JointAxIDIndx - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NConnections - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%ConnectionList))-1 ) = PACK(InData%ConnectionList,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%ConnectionList) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NConnectPreSplit - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cd - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CdMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Ca - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CaMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CpMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%JAxCd - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%JAxCa - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%JAxCp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AxCa - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AxCp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AxCaMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AxCpMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%R - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%t - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%tMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dRdz - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MGdensity - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%FillFSLoc - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%FillFlag , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%FillDensity - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%InpMbrIndx - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%InpMbrDist - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PropPot , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%R_LToG))-1 ) = PACK(InData%R_LToG,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%R_LToG) + IntKiBuf(Int_Xferred) = InData%NodeType + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%JointIndx + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%JointPos,1), UBOUND(InData%JointPos,1) + ReKiBuf(Re_Xferred) = InData%JointPos(i1) + Re_Xferred = Re_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%JointOvrlp + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%JointAxIDIndx + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NConnections + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%ConnectionList,1), UBOUND(InData%ConnectionList,1) + IntKiBuf(Int_Xferred) = InData%ConnectionList(i1) + Int_Xferred = Int_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%NConnectPreSplit + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cd + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CdMG + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Ca + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CaMG + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CpMG + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%JAxCd + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%JAxCa + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%JAxCp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AxCa + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AxCp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AxCaMG + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AxCpMG + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%R + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%t + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%tMG + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%dRdz + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MGdensity + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FillFSLoc + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%FillFlag, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FillDensity + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%InpMbrIndx + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%InpMbrDist + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%PropPot, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(InData%R_LToG,2), UBOUND(InData%R_LToG,2) + DO i1 = LBOUND(InData%R_LToG,1), UBOUND(InData%R_LToG,1) + ReKiBuf(Re_Xferred) = InData%R_LToG(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END SUBROUTINE Morison_PackNodeType SUBROUTINE Morison_UnPackNodeType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1787,12 +1748,6 @@ SUBROUTINE Morison_UnPackNodeType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -1808,101 +1763,88 @@ SUBROUTINE Morison_UnPackNodeType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%NodeType = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%JointIndx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NodeType = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%JointIndx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%JointPos,1) i1_u = UBOUND(OutData%JointPos,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%JointPos = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%JointPos))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%JointPos) - DEALLOCATE(mask1) - OutData%JointOvrlp = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%JointAxIDIndx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NConnections = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%JointPos,1), UBOUND(OutData%JointPos,1) + OutData%JointPos(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%JointOvrlp = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%JointAxIDIndx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NConnections = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%ConnectionList,1) i1_u = UBOUND(OutData%ConnectionList,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%ConnectionList = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%ConnectionList))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%ConnectionList) - DEALLOCATE(mask1) - OutData%NConnectPreSplit = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%Cd = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%CdMG = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Ca = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%CaMG = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%CpMG = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%JAxCd = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%JAxCa = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%JAxCp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%AxCa = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%AxCp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%AxCaMG = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%AxCpMG = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%R = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%t = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%tMG = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%dRdz = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MGdensity = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%FillFSLoc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%FillFlag = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%FillDensity = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%InpMbrIndx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%InpMbrDist = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PropPot = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%ConnectionList,1), UBOUND(OutData%ConnectionList,1) + OutData%ConnectionList(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + OutData%NConnectPreSplit = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%Cd = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%CdMG = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Ca = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%CaMG = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%CpMG = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%JAxCd = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%JAxCa = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%JAxCp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%AxCa = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%AxCp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%AxCaMG = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%AxCpMG = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%R = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%t = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%tMG = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%dRdz = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MGdensity = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%FillFSLoc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%FillFlag = TRANSFER(IntKiBuf(Int_Xferred), OutData%FillFlag) + Int_Xferred = Int_Xferred + 1 + OutData%FillDensity = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%InpMbrIndx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%InpMbrDist = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PropPot = TRANSFER(IntKiBuf(Int_Xferred), OutData%PropPot) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%R_LToG,1) i1_u = UBOUND(OutData%R_LToG,1) i2_l = LBOUND(OutData%R_LToG,2) i2_u = UBOUND(OutData%R_LToG,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%R_LToG = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%R_LToG))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%R_LToG) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%R_LToG,2), UBOUND(OutData%R_LToG,2) + DO i1 = LBOUND(OutData%R_LToG,1), UBOUND(OutData%R_LToG,1) + OutData%R_LToG(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END SUBROUTINE Morison_UnPackNodeType SUBROUTINE Morison_CopyMemberType( SrcMemberTypeData, DstMemberTypeData, CtrlCode, ErrStat, ErrMsg ) @@ -2082,92 +2024,102 @@ SUBROUTINE Morison_PackMemberType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Node1Indx - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Node2Indx - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%R1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%t1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%R2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%t2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cd1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CdMG1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Ca1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CaMG1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cp1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CpMG1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AxCa1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AxCaMG1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AxCp1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AxCpMG1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cd2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CdMG2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Ca2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CaMG2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cp2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CpMG2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AxCa2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AxCaMG2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AxCp2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AxCpMG2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%InpMbrDist1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%InpMbrDist2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%InpMbrLen - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%InpMbrIndx - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%R_LToG))-1 ) = PACK(InData%R_LToG,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%R_LToG) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumSplits - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Splits))-1 ) = PACK(InData%Splits,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Splits) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MGvolume - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MDivSize - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MCoefMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MmbrCoefIDIndx - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MmbrFilledIDIndx - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%FillFSLoc - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%FillDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F_Bouy))-1 ) = PACK(InData%F_Bouy,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F_Bouy) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F_DP))-1 ) = PACK(InData%F_DP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F_DP) - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PropPot , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Node1Indx + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Node2Indx + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%R1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%t1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%R2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%t2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cd1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CdMG1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Ca1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CaMG1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cp1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CpMG1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AxCa1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AxCaMG1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AxCp1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AxCpMG1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cd2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CdMG2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Ca2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CaMG2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cp2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CpMG2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AxCa2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AxCaMG2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AxCp2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AxCpMG2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%InpMbrDist1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%InpMbrDist2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%InpMbrLen + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%InpMbrIndx + Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(InData%R_LToG,2), UBOUND(InData%R_LToG,2) + DO i1 = LBOUND(InData%R_LToG,1), UBOUND(InData%R_LToG,1) + ReKiBuf(Re_Xferred) = InData%R_LToG(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + IntKiBuf(Int_Xferred) = InData%NumSplits + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%Splits,1), UBOUND(InData%Splits,1) + ReKiBuf(Re_Xferred) = InData%Splits(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%MGvolume + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MDivSize + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MCoefMod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MmbrCoefIDIndx + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MmbrFilledIDIndx + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FillFSLoc + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FillDens + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%F_Bouy,1), UBOUND(InData%F_Bouy,1) + ReKiBuf(Re_Xferred) = InData%F_Bouy(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%F_DP,1), UBOUND(InData%F_DP,1) + ReKiBuf(Re_Xferred) = InData%F_DP(i1) + Re_Xferred = Re_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = TRANSFER(InData%PropPot, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Morison_PackMemberType SUBROUTINE Morison_UnPackMemberType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2183,12 +2135,6 @@ SUBROUTINE Morison_UnPackMemberType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -2204,130 +2150,112 @@ SUBROUTINE Morison_UnPackMemberType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%Node1Indx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%Node2Indx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%R1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%t1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%R2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%t2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cd1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%CdMG1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Ca1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%CaMG1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cp1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%CpMG1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%AxCa1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%AxCaMG1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%AxCp1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%AxCpMG1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cd2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%CdMG2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Ca2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%CaMG2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cp2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%CpMG2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%AxCa2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%AxCaMG2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%AxCp2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%AxCpMG2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%InpMbrDist1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%InpMbrDist2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%InpMbrLen = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%InpMbrIndx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%Node1Indx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%Node2Indx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%R1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%t1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%R2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%t2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cd1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%CdMG1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Ca1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%CaMG1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cp1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%CpMG1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%AxCa1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%AxCaMG1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%AxCp1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%AxCpMG1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cd2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%CdMG2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Ca2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%CaMG2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cp2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%CpMG2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%AxCa2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%AxCaMG2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%AxCp2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%AxCpMG2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%InpMbrDist1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%InpMbrDist2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%InpMbrLen = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%InpMbrIndx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%R_LToG,1) i1_u = UBOUND(OutData%R_LToG,1) i2_l = LBOUND(OutData%R_LToG,2) i2_u = UBOUND(OutData%R_LToG,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%R_LToG = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%R_LToG))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%R_LToG) - DEALLOCATE(mask2) - OutData%NumSplits = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(OutData%R_LToG,2), UBOUND(OutData%R_LToG,2) + DO i1 = LBOUND(OutData%R_LToG,1), UBOUND(OutData%R_LToG,1) + OutData%R_LToG(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + OutData%NumSplits = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%Splits,1) i1_u = UBOUND(OutData%Splits,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%Splits = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Splits))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Splits) - DEALLOCATE(mask1) - OutData%MGvolume = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MDivSize = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MCoefMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%MmbrCoefIDIndx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%MmbrFilledIDIndx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%FillFSLoc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%FillDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%Splits,1), UBOUND(OutData%Splits,1) + OutData%Splits(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%MGvolume = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MDivSize = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MCoefMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%MmbrCoefIDIndx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%MmbrFilledIDIndx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%FillFSLoc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%FillDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%F_Bouy,1) i1_u = UBOUND(OutData%F_Bouy,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%F_Bouy = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F_Bouy))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F_Bouy) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%F_Bouy,1), UBOUND(OutData%F_Bouy,1) + OutData%F_Bouy(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%F_DP,1) i1_u = UBOUND(OutData%F_DP,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%F_DP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F_DP))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F_DP) - DEALLOCATE(mask1) - OutData%PropPot = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%F_DP,1), UBOUND(OutData%F_DP,1) + OutData%F_DP(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%PropPot = TRANSFER(IntKiBuf(Int_Xferred), OutData%PropPot) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Morison_UnPackMemberType SUBROUTINE Morison_CopyCoefMembers( SrcCoefMembersData, DstCoefMembersData, CtrlCode, ErrStat, ErrMsg ) @@ -2461,48 +2389,48 @@ SUBROUTINE Morison_PackCoefMembers( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MemberID - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MemberCd1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MemberCd2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MemberCdMG1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MemberCdMG2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MemberCa1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MemberCa2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MemberCaMG1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MemberCaMG2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MemberCp1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MemberCp2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MemberCpMG1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MemberCpMG2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MemberAxCa1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MemberAxCa2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MemberAxCaMG1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MemberAxCaMG2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MemberAxCp1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MemberAxCp2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MemberAxCpMG1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MemberAxCpMG2 - Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MemberID + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MemberCd1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MemberCd2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MemberCdMG1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MemberCdMG2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MemberCa1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MemberCa2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MemberCaMG1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MemberCaMG2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MemberCp1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MemberCp2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MemberCpMG1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MemberCpMG2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MemberAxCa1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MemberAxCa2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MemberAxCaMG1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MemberAxCaMG2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MemberAxCp1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MemberAxCp2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MemberAxCpMG1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MemberAxCpMG2 + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Morison_PackCoefMembers SUBROUTINE Morison_UnPackCoefMembers( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2518,12 +2446,6 @@ SUBROUTINE Morison_UnPackCoefMembers( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Morison_UnPackCoefMembers' @@ -2537,48 +2459,48 @@ SUBROUTINE Morison_UnPackCoefMembers( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%MemberID = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%MemberCd1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCd2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCdMG1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCdMG2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCa1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCa2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCaMG1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCaMG2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCp1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCp2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCpMG1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MemberCpMG2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MemberAxCa1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MemberAxCa2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MemberAxCaMG1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MemberAxCaMG2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MemberAxCp1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MemberAxCp2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MemberAxCpMG1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MemberAxCpMG2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%MemberID = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%MemberCd1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MemberCd2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MemberCdMG1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MemberCdMG2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MemberCa1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MemberCa2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MemberCaMG1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MemberCaMG2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MemberCp1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MemberCp2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MemberCpMG1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MemberCpMG2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MemberAxCa1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MemberAxCa2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MemberAxCaMG1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MemberAxCaMG2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MemberAxCp1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MemberAxCp2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MemberAxCpMG1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MemberAxCpMG2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Morison_UnPackCoefMembers SUBROUTINE Morison_CopyMGDepthsType( SrcMGDepthsTypeData, DstMGDepthsTypeData, CtrlCode, ErrStat, ErrMsg ) @@ -2676,12 +2598,12 @@ SUBROUTINE Morison_PackMGDepthsType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MGDpth - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MGThck - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MGDens - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MGDpth + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MGThck + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MGDens + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Morison_PackMGDepthsType SUBROUTINE Morison_UnPackMGDepthsType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2697,12 +2619,6 @@ SUBROUTINE Morison_UnPackMGDepthsType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Morison_UnPackMGDepthsType' @@ -2716,12 +2632,12 @@ SUBROUTINE Morison_UnPackMGDepthsType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%MGDpth = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MGThck = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MGDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%MGDpth = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MGThck = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MGDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Morison_UnPackMGDepthsType SUBROUTINE Morison_CopyMOutput( SrcMOutputData, DstMOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -2900,10 +2816,10 @@ SUBROUTINE Morison_PackMOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MemberID - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NOutLoc - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MemberID + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NOutLoc + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%NodeLocs) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2914,11 +2830,13 @@ SUBROUTINE Morison_PackMOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodeLocs,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%NodeLocs)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%NodeLocs))-1 ) = PACK(InData%NodeLocs,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%NodeLocs) + DO i1 = LBOUND(InData%NodeLocs,1), UBOUND(InData%NodeLocs,1) + ReKiBuf(Re_Xferred) = InData%NodeLocs(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MemberIDIndx - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MemberIDIndx + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%Marker1) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2929,8 +2847,10 @@ SUBROUTINE Morison_PackMOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Marker1,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Marker1)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%Marker1))-1 ) = PACK(InData%Marker1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%Marker1) + DO i1 = LBOUND(InData%Marker1,1), UBOUND(InData%Marker1,1) + IntKiBuf(Int_Xferred) = InData%Marker1(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%Marker2) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2942,8 +2862,10 @@ SUBROUTINE Morison_PackMOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Marker2,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Marker2)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%Marker2))-1 ) = PACK(InData%Marker2,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%Marker2) + DO i1 = LBOUND(InData%Marker2,1), UBOUND(InData%Marker2,1) + IntKiBuf(Int_Xferred) = InData%Marker2(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%s) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2955,8 +2877,10 @@ SUBROUTINE Morison_PackMOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%s,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%s)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%s))-1 ) = PACK(InData%s,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%s) + DO i1 = LBOUND(InData%s,1), UBOUND(InData%s,1) + ReKiBuf(Re_Xferred) = InData%s(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE Morison_PackMOutput @@ -2973,12 +2897,6 @@ SUBROUTINE Morison_UnPackMOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -2993,10 +2911,10 @@ SUBROUTINE Morison_UnPackMOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%MemberID = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NOutLoc = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%MemberID = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NOutLoc = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NodeLocs not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3010,18 +2928,13 @@ SUBROUTINE Morison_UnPackMOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodeLocs.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%NodeLocs)>0) OutData%NodeLocs = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%NodeLocs))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%NodeLocs) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%NodeLocs,1), UBOUND(OutData%NodeLocs,1) + OutData%NodeLocs(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%MemberIDIndx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%MemberIDIndx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Marker1 not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3035,15 +2948,10 @@ SUBROUTINE Morison_UnPackMOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Marker1.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Marker1)>0) OutData%Marker1 = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%Marker1))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%Marker1) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Marker1,1), UBOUND(OutData%Marker1,1) + OutData%Marker1(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Marker2 not allocated Int_Xferred = Int_Xferred + 1 @@ -3058,15 +2966,10 @@ SUBROUTINE Morison_UnPackMOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Marker2.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Marker2)>0) OutData%Marker2 = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%Marker2))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%Marker2) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Marker2,1), UBOUND(OutData%Marker2,1) + OutData%Marker2(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! s not allocated Int_Xferred = Int_Xferred + 1 @@ -3081,15 +2984,10 @@ SUBROUTINE Morison_UnPackMOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%s.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%s)>0) OutData%s = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%s))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%s) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%s,1), UBOUND(OutData%s,1) + OutData%s(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE Morison_UnPackMOutput @@ -3191,14 +3089,16 @@ SUBROUTINE Morison_PackJOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%JointID - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%JointIDIndx - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumMarkers - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%Markers))-1 ) = PACK(InData%Markers,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%Markers) + IntKiBuf(Int_Xferred) = InData%JointID + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%JointIDIndx + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumMarkers + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%Markers,1), UBOUND(InData%Markers,1) + IntKiBuf(Int_Xferred) = InData%Markers(i1) + Int_Xferred = Int_Xferred + 1 + END DO END SUBROUTINE Morison_PackJOutput SUBROUTINE Morison_UnPackJOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -3214,12 +3114,6 @@ SUBROUTINE Morison_UnPackJOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -3234,23 +3128,18 @@ SUBROUTINE Morison_UnPackJOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%JointID = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%JointIDIndx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumMarkers = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%JointID = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%JointIDIndx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumMarkers = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%Markers,1) i1_u = UBOUND(OutData%Markers,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%Markers = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%Markers))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%Markers) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Markers,1), UBOUND(OutData%Markers,1) + OutData%Markers(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END SUBROUTINE Morison_UnPackJOutput SUBROUTINE Morison_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) @@ -4092,20 +3981,20 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WtrDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MSL2SWL - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NJoints - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NNodes - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TotalPossibleSuperMembers - Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Gravity + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDens + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDpth + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MSL2SWL + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NJoints + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NNodes + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TotalPossibleSuperMembers + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%InpJoints) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4188,8 +4077,8 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ENDIF END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NElements - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NElements + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%Elements) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4231,8 +4120,8 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ENDIF END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NAxCoefs - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NAxCoefs + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%AxialCoefs) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4274,8 +4163,8 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ENDIF END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NPropSets - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NPropSets + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%MPropSets) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4317,28 +4206,28 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ENDIF END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SimplCd - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SimplCdMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SimplCa - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SimplCaMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SimplCp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SimplCpMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SimplAxCa - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SimplAxCaMG - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SimplAxCp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SimplAxCpMG - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NCoefDpth - Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SimplCd + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SimplCdMG + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SimplCa + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SimplCaMG + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SimplCp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SimplCpMG + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SimplAxCa + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SimplAxCaMG + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SimplAxCp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SimplAxCpMG + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NCoefDpth + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%CoefDpths) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4380,8 +4269,8 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ENDIF END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NCoefMembers - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NCoefMembers + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%CoefMembers) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4423,8 +4312,8 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ENDIF END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NMembers - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NMembers + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%InpMembers) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4466,8 +4355,8 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ENDIF END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NFillGroups - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NFillGroups + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%FilledGroups) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4509,8 +4398,8 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ENDIF END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NMGDepths - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NMGDepths + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%MGDepths) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4552,12 +4441,12 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ENDIF END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MGTop - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MGBottom - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NMOutputs - Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MGTop + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MGBottom + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NMOutputs + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%MOutLst) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4599,8 +4488,8 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ENDIF END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NJOutputs - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NJOutputs + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%JOutLst) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4643,11 +4532,11 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E END DO END IF DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) - DO I = 1, LEN(InData%OutList) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 + DO I = 1, LEN(InData%OutList) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO IF ( .NOT. ALLOCATED(InData%ValidOutList) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4658,25 +4547,27 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ValidOutList,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ValidOutList)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%ValidOutList)-1 ) = TRANSFER(PACK( InData%ValidOutList ,.TRUE.), IntKiBuf(1), SIZE(InData%ValidOutList)) - Int_Xferred = Int_Xferred + SIZE(InData%ValidOutList) + DO i1 = LBOUND(InData%ValidOutList,1), UBOUND(InData%ValidOutList,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%ValidOutList(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%OutSwtch - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%OutAll , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutRootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutRootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UnOutFile - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UnSum - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%OutSwtch + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%OutAll, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%OutRootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutRootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%UnOutFile + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%UnSum + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepWave + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WaveAcc) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4693,8 +4584,14 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveAcc)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveAcc))-1 ) = PACK(InData%WaveAcc,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveAcc) + DO i3 = LBOUND(InData%WaveAcc,3), UBOUND(InData%WaveAcc,3) + DO i2 = LBOUND(InData%WaveAcc,2), UBOUND(InData%WaveAcc,2) + DO i1 = LBOUND(InData%WaveAcc,1), UBOUND(InData%WaveAcc,1) + ReKiBuf(Re_Xferred) = InData%WaveAcc(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveTime) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4706,8 +4603,10 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveTime)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveTime))-1 ) = PACK(InData%WaveTime,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveTime) + DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) + ReKiBuf(Re_Xferred) = InData%WaveTime(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveDynP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4722,8 +4621,12 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveDynP)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveDynP))-1 ) = PACK(InData%WaveDynP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveDynP) + DO i2 = LBOUND(InData%WaveDynP,2), UBOUND(InData%WaveDynP,2) + DO i1 = LBOUND(InData%WaveDynP,1), UBOUND(InData%WaveDynP,1) + ReKiBuf(Re_Xferred) = InData%WaveDynP(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveVel) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4741,8 +4644,14 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveVel)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveVel))-1 ) = PACK(InData%WaveVel,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveVel) + DO i3 = LBOUND(InData%WaveVel,3), UBOUND(InData%WaveVel,3) + DO i2 = LBOUND(InData%WaveVel,2), UBOUND(InData%WaveVel,2) + DO i1 = LBOUND(InData%WaveVel,1), UBOUND(InData%WaveVel,1) + ReKiBuf(Re_Xferred) = InData%WaveVel(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%nodeInWater) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4757,8 +4666,12 @@ SUBROUTINE Morison_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%nodeInWater,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%nodeInWater)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%nodeInWater))-1 ) = PACK(InData%nodeInWater,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%nodeInWater) + DO i2 = LBOUND(InData%nodeInWater,2), UBOUND(InData%nodeInWater,2) + DO i1 = LBOUND(InData%nodeInWater,1), UBOUND(InData%nodeInWater,1) + IntKiBuf(Int_Xferred) = InData%nodeInWater(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF END SUBROUTINE Morison_PackInitInput @@ -4775,12 +4688,6 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (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 @@ -4797,20 +4704,20 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%Gravity = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDpth = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MSL2SWL = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NJoints = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NNodes = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TotalPossibleSuperMembers = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%Gravity = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WtrDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WtrDpth = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MSL2SWL = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NJoints = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NNodes = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TotalPossibleSuperMembers = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InpJoints not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -4923,8 +4830,8 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%NElements = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NElements = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Elements not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -4981,8 +4888,8 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%NAxCoefs = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NAxCoefs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AxialCoefs not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5039,8 +4946,8 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%NPropSets = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NPropSets = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MPropSets not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5097,28 +5004,28 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%SimplCd = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SimplCdMG = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SimplCa = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SimplCaMG = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SimplCp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SimplCpMG = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SimplAxCa = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SimplAxCaMG = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SimplAxCp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SimplAxCpMG = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NCoefDpth = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%SimplCd = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SimplCdMG = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SimplCa = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SimplCaMG = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SimplCp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SimplCpMG = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SimplAxCa = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SimplAxCaMG = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SimplAxCp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SimplAxCpMG = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NCoefDpth = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CoefDpths not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5175,8 +5082,8 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%NCoefMembers = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NCoefMembers = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CoefMembers not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5233,8 +5140,8 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%NMembers = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NMembers = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InpMembers not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5291,8 +5198,8 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%NFillGroups = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NFillGroups = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FilledGroups not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5349,8 +5256,8 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%NMGDepths = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NMGDepths = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MGDepths not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5407,12 +5314,12 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%MGTop = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MGBottom = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NMOutputs = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%MGTop = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MGBottom = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NMOutputs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MOutLst not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5469,8 +5376,8 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%NJOutputs = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NJOutputs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! JOutLst not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5529,19 +5436,12 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat END IF i1_l = LBOUND(OutData%OutList,1) i1_u = UBOUND(OutData%OutList,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) - DO I = 1, LEN(OutData%OutList) - OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - DEALLOCATE(mask1) + DO I = 1, LEN(OutData%OutList) + OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ValidOutList not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5555,32 +5455,27 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ValidOutList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%ValidOutList)>0) OutData%ValidOutList = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%ValidOutList))-1 ), OutData%ValidOutList), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%ValidOutList) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%ValidOutList,1), UBOUND(OutData%ValidOutList,1) + OutData%ValidOutList(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%ValidOutList(i1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%OutSwtch = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%OutAll = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutRootName) - OutData%OutRootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%UnOutFile = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%UnSum = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NStepWave = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%OutSwtch = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%OutAll = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutAll) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%OutRootName) + OutData%OutRootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%UnOutFile = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%UnSum = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NStepWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAcc not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5600,15 +5495,14 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%WaveAcc)>0) OutData%WaveAcc = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveAcc))-1 ), mask3, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveAcc) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%WaveAcc,3), UBOUND(OutData%WaveAcc,3) + DO i2 = LBOUND(OutData%WaveAcc,2), UBOUND(OutData%WaveAcc,2) + DO i1 = LBOUND(OutData%WaveAcc,1), UBOUND(OutData%WaveAcc,1) + OutData%WaveAcc(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated Int_Xferred = Int_Xferred + 1 @@ -5623,15 +5517,10 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveTime)>0) OutData%WaveTime = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveTime))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveTime) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) + OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDynP not allocated Int_Xferred = Int_Xferred + 1 @@ -5649,15 +5538,12 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveDynP)>0) OutData%WaveDynP = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveDynP))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveDynP) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveDynP,2), UBOUND(OutData%WaveDynP,2) + DO i1 = LBOUND(OutData%WaveDynP,1), UBOUND(OutData%WaveDynP,1) + OutData%WaveDynP(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveVel not allocated Int_Xferred = Int_Xferred + 1 @@ -5678,15 +5564,14 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%WaveVel)>0) OutData%WaveVel = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveVel))-1 ), mask3, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveVel) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%WaveVel,3), UBOUND(OutData%WaveVel,3) + DO i2 = LBOUND(OutData%WaveVel,2), UBOUND(OutData%WaveVel,2) + DO i1 = LBOUND(OutData%WaveVel,1), UBOUND(OutData%WaveVel,1) + OutData%WaveVel(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! nodeInWater not allocated Int_Xferred = Int_Xferred + 1 @@ -5704,15 +5589,12 @@ SUBROUTINE Morison_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%nodeInWater.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%nodeInWater)>0) OutData%nodeInWater = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%nodeInWater))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%nodeInWater) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%nodeInWater,2), UBOUND(OutData%nodeInWater,2) + DO i1 = LBOUND(OutData%nodeInWater,1), UBOUND(OutData%nodeInWater,1) + OutData%nodeInWater(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF END SUBROUTINE Morison_UnPackInitInput @@ -5975,8 +5857,10 @@ SUBROUTINE Morison_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Morison_Rad,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Morison_Rad)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Morison_Rad))-1 ) = PACK(InData%Morison_Rad,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Morison_Rad) + DO i1 = LBOUND(InData%Morison_Rad,1), UBOUND(InData%Morison_Rad,1) + ReKiBuf(Re_Xferred) = InData%Morison_Rad(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutputHdr) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5988,12 +5872,12 @@ SUBROUTINE Morison_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6005,12 +5889,12 @@ SUBROUTINE Morison_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF END SUBROUTINE Morison_PackInitOutput @@ -6027,12 +5911,6 @@ SUBROUTINE Morison_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -6140,15 +6018,10 @@ SUBROUTINE Morison_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Morison_Rad.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Morison_Rad)>0) OutData%Morison_Rad = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Morison_Rad))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%Morison_Rad) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Morison_Rad,1), UBOUND(OutData%Morison_Rad,1) + OutData%Morison_Rad(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputHdr not allocated Int_Xferred = Int_Xferred + 1 @@ -6163,19 +6036,12 @@ SUBROUTINE Morison_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated Int_Xferred = Int_Xferred + 1 @@ -6190,19 +6056,12 @@ SUBROUTINE Morison_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF END SUBROUTINE Morison_UnPackInitOutput @@ -6297,8 +6156,8 @@ SUBROUTINE Morison_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyContState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyContState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Morison_PackContState SUBROUTINE Morison_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -6314,12 +6173,6 @@ SUBROUTINE Morison_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Morison_UnPackContState' @@ -6333,8 +6186,8 @@ SUBROUTINE Morison_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyContState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyContState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Morison_UnPackContState SUBROUTINE Morison_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) @@ -6428,8 +6281,8 @@ SUBROUTINE Morison_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyDiscState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyDiscState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Morison_PackDiscState SUBROUTINE Morison_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -6445,12 +6298,6 @@ SUBROUTINE Morison_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Morison_UnPackDiscState' @@ -6464,8 +6311,8 @@ SUBROUTINE Morison_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyDiscState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyDiscState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Morison_UnPackDiscState SUBROUTINE Morison_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) @@ -6559,8 +6406,8 @@ SUBROUTINE Morison_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyConstrState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Morison_PackConstrState SUBROUTINE Morison_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -6576,12 +6423,6 @@ SUBROUTINE Morison_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Morison_UnPackConstrState' @@ -6595,8 +6436,8 @@ SUBROUTINE Morison_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyConstrState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyConstrState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Morison_UnPackConstrState SUBROUTINE Morison_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -6690,8 +6531,8 @@ SUBROUTINE Morison_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DummyOtherState - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DummyOtherState + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Morison_PackOtherState SUBROUTINE Morison_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -6707,12 +6548,6 @@ SUBROUTINE Morison_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Morison_UnPackOtherState' @@ -6726,8 +6561,8 @@ SUBROUTINE Morison_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyOtherState = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%DummyOtherState = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Morison_UnPackOtherState SUBROUTINE Morison_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) @@ -7228,8 +7063,12 @@ SUBROUTINE Morison_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_F_D,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D_F_D)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D_F_D))-1 ) = PACK(InData%D_F_D,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D_F_D) + DO i2 = LBOUND(InData%D_F_D,2), UBOUND(InData%D_F_D,2) + DO i1 = LBOUND(InData%D_F_D,1), UBOUND(InData%D_F_D,1) + ReKiBuf(Re_Xferred) = InData%D_F_D(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%D_F_I) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7244,8 +7083,12 @@ SUBROUTINE Morison_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_F_I,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D_F_I)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D_F_I))-1 ) = PACK(InData%D_F_I,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D_F_I) + DO i2 = LBOUND(InData%D_F_I,2), UBOUND(InData%D_F_I,2) + DO i1 = LBOUND(InData%D_F_I,1), UBOUND(InData%D_F_I,1) + ReKiBuf(Re_Xferred) = InData%D_F_I(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%D_F_B) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7260,8 +7103,12 @@ SUBROUTINE Morison_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_F_B,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D_F_B)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D_F_B))-1 ) = PACK(InData%D_F_B,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D_F_B) + DO i2 = LBOUND(InData%D_F_B,2), UBOUND(InData%D_F_B,2) + DO i1 = LBOUND(InData%D_F_B,1), UBOUND(InData%D_F_B,1) + ReKiBuf(Re_Xferred) = InData%D_F_B(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%D_F_AM) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7276,8 +7123,12 @@ SUBROUTINE Morison_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_F_AM,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D_F_AM)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D_F_AM))-1 ) = PACK(InData%D_F_AM,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D_F_AM) + DO i2 = LBOUND(InData%D_F_AM,2), UBOUND(InData%D_F_AM,2) + DO i1 = LBOUND(InData%D_F_AM,1), UBOUND(InData%D_F_AM,1) + ReKiBuf(Re_Xferred) = InData%D_F_AM(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%D_F_AM_M) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7292,8 +7143,12 @@ SUBROUTINE Morison_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_F_AM_M,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D_F_AM_M)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D_F_AM_M))-1 ) = PACK(InData%D_F_AM_M,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D_F_AM_M) + DO i2 = LBOUND(InData%D_F_AM_M,2), UBOUND(InData%D_F_AM_M,2) + DO i1 = LBOUND(InData%D_F_AM_M,1), UBOUND(InData%D_F_AM_M,1) + ReKiBuf(Re_Xferred) = InData%D_F_AM_M(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%D_F_AM_MG) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7308,8 +7163,12 @@ SUBROUTINE Morison_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_F_AM_MG,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D_F_AM_MG)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D_F_AM_MG))-1 ) = PACK(InData%D_F_AM_MG,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D_F_AM_MG) + DO i2 = LBOUND(InData%D_F_AM_MG,2), UBOUND(InData%D_F_AM_MG,2) + DO i1 = LBOUND(InData%D_F_AM_MG,1), UBOUND(InData%D_F_AM_MG,1) + ReKiBuf(Re_Xferred) = InData%D_F_AM_MG(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%D_F_AM_F) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7324,8 +7183,12 @@ SUBROUTINE Morison_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_F_AM_F,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D_F_AM_F)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D_F_AM_F))-1 ) = PACK(InData%D_F_AM_F,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D_F_AM_F) + DO i2 = LBOUND(InData%D_F_AM_F,2), UBOUND(InData%D_F_AM_F,2) + DO i1 = LBOUND(InData%D_F_AM_F,1), UBOUND(InData%D_F_AM_F,1) + ReKiBuf(Re_Xferred) = InData%D_F_AM_F(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%D_FV) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7340,8 +7203,12 @@ SUBROUTINE Morison_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_FV,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D_FV)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D_FV))-1 ) = PACK(InData%D_FV,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D_FV) + DO i2 = LBOUND(InData%D_FV,2), UBOUND(InData%D_FV,2) + DO i1 = LBOUND(InData%D_FV,1), UBOUND(InData%D_FV,1) + ReKiBuf(Re_Xferred) = InData%D_FV(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%D_FA) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7356,8 +7223,12 @@ SUBROUTINE Morison_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_FA,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D_FA)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D_FA))-1 ) = PACK(InData%D_FA,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D_FA) + DO i2 = LBOUND(InData%D_FA,2), UBOUND(InData%D_FA,2) + DO i1 = LBOUND(InData%D_FA,1), UBOUND(InData%D_FA,1) + ReKiBuf(Re_Xferred) = InData%D_FA(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%D_FDynP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7369,8 +7240,10 @@ SUBROUTINE Morison_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_FDynP,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D_FDynP)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D_FDynP))-1 ) = PACK(InData%D_FDynP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D_FDynP) + DO i1 = LBOUND(InData%D_FDynP,1), UBOUND(InData%D_FDynP,1) + ReKiBuf(Re_Xferred) = InData%D_FDynP(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%L_F_B) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7385,8 +7258,12 @@ SUBROUTINE Morison_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%L_F_B,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%L_F_B)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%L_F_B))-1 ) = PACK(InData%L_F_B,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%L_F_B) + DO i2 = LBOUND(InData%L_F_B,2), UBOUND(InData%L_F_B,2) + DO i1 = LBOUND(InData%L_F_B,1), UBOUND(InData%L_F_B,1) + ReKiBuf(Re_Xferred) = InData%L_F_B(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%L_F_D) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7401,8 +7278,12 @@ SUBROUTINE Morison_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%L_F_D,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%L_F_D)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%L_F_D))-1 ) = PACK(InData%L_F_D,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%L_F_D) + DO i2 = LBOUND(InData%L_F_D,2), UBOUND(InData%L_F_D,2) + DO i1 = LBOUND(InData%L_F_D,1), UBOUND(InData%L_F_D,1) + ReKiBuf(Re_Xferred) = InData%L_F_D(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%L_F_I) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7417,8 +7298,12 @@ SUBROUTINE Morison_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%L_F_I,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%L_F_I)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%L_F_I))-1 ) = PACK(InData%L_F_I,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%L_F_I) + DO i2 = LBOUND(InData%L_F_I,2), UBOUND(InData%L_F_I,2) + DO i1 = LBOUND(InData%L_F_I,1), UBOUND(InData%L_F_I,1) + ReKiBuf(Re_Xferred) = InData%L_F_I(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%L_F_DP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7433,8 +7318,12 @@ SUBROUTINE Morison_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%L_F_DP,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%L_F_DP)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%L_F_DP))-1 ) = PACK(InData%L_F_DP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%L_F_DP) + DO i2 = LBOUND(InData%L_F_DP,2), UBOUND(InData%L_F_DP,2) + DO i1 = LBOUND(InData%L_F_DP,1), UBOUND(InData%L_F_DP,1) + ReKiBuf(Re_Xferred) = InData%L_F_DP(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%L_F_AM) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7449,8 +7338,12 @@ SUBROUTINE Morison_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%L_F_AM,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%L_F_AM)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%L_F_AM))-1 ) = PACK(InData%L_F_AM,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%L_F_AM) + DO i2 = LBOUND(InData%L_F_AM,2), UBOUND(InData%L_F_AM,2) + DO i1 = LBOUND(InData%L_F_AM,1), UBOUND(InData%L_F_AM,1) + ReKiBuf(Re_Xferred) = InData%L_F_AM(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%L_FV) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7465,8 +7358,12 @@ SUBROUTINE Morison_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%L_FV,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%L_FV)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%L_FV))-1 ) = PACK(InData%L_FV,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%L_FV) + DO i2 = LBOUND(InData%L_FV,2), UBOUND(InData%L_FV,2) + DO i1 = LBOUND(InData%L_FV,1), UBOUND(InData%L_FV,1) + ReKiBuf(Re_Xferred) = InData%L_FV(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%L_FA) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7481,8 +7378,12 @@ SUBROUTINE Morison_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%L_FA,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%L_FA)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%L_FA))-1 ) = PACK(InData%L_FA,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%L_FA) + DO i2 = LBOUND(InData%L_FA,2), UBOUND(InData%L_FA,2) + DO i1 = LBOUND(InData%L_FA,1), UBOUND(InData%L_FA,1) + ReKiBuf(Re_Xferred) = InData%L_FA(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%L_FDynP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7494,11 +7395,13 @@ SUBROUTINE Morison_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%L_FDynP,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%L_FDynP)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%L_FDynP))-1 ) = PACK(InData%L_FDynP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%L_FDynP) + DO i1 = LBOUND(InData%L_FDynP,1), UBOUND(InData%L_FDynP,1) + ReKiBuf(Re_Xferred) = InData%L_FDynP(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%LastIndWave - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%LastIndWave + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Morison_PackMisc SUBROUTINE Morison_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -7514,12 +7417,6 @@ SUBROUTINE Morison_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -7551,15 +7448,12 @@ SUBROUTINE Morison_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_F_D.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%D_F_D)>0) OutData%D_F_D = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D_F_D))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D_F_D) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%D_F_D,2), UBOUND(OutData%D_F_D,2) + DO i1 = LBOUND(OutData%D_F_D,1), UBOUND(OutData%D_F_D,1) + OutData%D_F_D(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D_F_I not allocated Int_Xferred = Int_Xferred + 1 @@ -7577,15 +7471,12 @@ SUBROUTINE Morison_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_F_I.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%D_F_I)>0) OutData%D_F_I = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D_F_I))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D_F_I) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%D_F_I,2), UBOUND(OutData%D_F_I,2) + DO i1 = LBOUND(OutData%D_F_I,1), UBOUND(OutData%D_F_I,1) + OutData%D_F_I(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D_F_B not allocated Int_Xferred = Int_Xferred + 1 @@ -7603,15 +7494,12 @@ SUBROUTINE Morison_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_F_B.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%D_F_B)>0) OutData%D_F_B = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D_F_B))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D_F_B) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%D_F_B,2), UBOUND(OutData%D_F_B,2) + DO i1 = LBOUND(OutData%D_F_B,1), UBOUND(OutData%D_F_B,1) + OutData%D_F_B(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D_F_AM not allocated Int_Xferred = Int_Xferred + 1 @@ -7629,15 +7517,12 @@ SUBROUTINE Morison_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_F_AM.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%D_F_AM)>0) OutData%D_F_AM = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D_F_AM))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D_F_AM) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%D_F_AM,2), UBOUND(OutData%D_F_AM,2) + DO i1 = LBOUND(OutData%D_F_AM,1), UBOUND(OutData%D_F_AM,1) + OutData%D_F_AM(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D_F_AM_M not allocated Int_Xferred = Int_Xferred + 1 @@ -7655,15 +7540,12 @@ SUBROUTINE Morison_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_F_AM_M.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%D_F_AM_M)>0) OutData%D_F_AM_M = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D_F_AM_M))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D_F_AM_M) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%D_F_AM_M,2), UBOUND(OutData%D_F_AM_M,2) + DO i1 = LBOUND(OutData%D_F_AM_M,1), UBOUND(OutData%D_F_AM_M,1) + OutData%D_F_AM_M(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D_F_AM_MG not allocated Int_Xferred = Int_Xferred + 1 @@ -7681,15 +7563,12 @@ SUBROUTINE Morison_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_F_AM_MG.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%D_F_AM_MG)>0) OutData%D_F_AM_MG = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D_F_AM_MG))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D_F_AM_MG) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%D_F_AM_MG,2), UBOUND(OutData%D_F_AM_MG,2) + DO i1 = LBOUND(OutData%D_F_AM_MG,1), UBOUND(OutData%D_F_AM_MG,1) + OutData%D_F_AM_MG(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D_F_AM_F not allocated Int_Xferred = Int_Xferred + 1 @@ -7707,15 +7586,12 @@ SUBROUTINE Morison_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_F_AM_F.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%D_F_AM_F)>0) OutData%D_F_AM_F = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D_F_AM_F))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D_F_AM_F) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%D_F_AM_F,2), UBOUND(OutData%D_F_AM_F,2) + DO i1 = LBOUND(OutData%D_F_AM_F,1), UBOUND(OutData%D_F_AM_F,1) + OutData%D_F_AM_F(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D_FV not allocated Int_Xferred = Int_Xferred + 1 @@ -7733,15 +7609,12 @@ SUBROUTINE Morison_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_FV.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%D_FV)>0) OutData%D_FV = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D_FV))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D_FV) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%D_FV,2), UBOUND(OutData%D_FV,2) + DO i1 = LBOUND(OutData%D_FV,1), UBOUND(OutData%D_FV,1) + OutData%D_FV(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D_FA not allocated Int_Xferred = Int_Xferred + 1 @@ -7759,15 +7632,12 @@ SUBROUTINE Morison_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_FA.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%D_FA)>0) OutData%D_FA = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D_FA))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D_FA) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%D_FA,2), UBOUND(OutData%D_FA,2) + DO i1 = LBOUND(OutData%D_FA,1), UBOUND(OutData%D_FA,1) + OutData%D_FA(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D_FDynP not allocated Int_Xferred = Int_Xferred + 1 @@ -7782,15 +7652,10 @@ SUBROUTINE Morison_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_FDynP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%D_FDynP)>0) OutData%D_FDynP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D_FDynP))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D_FDynP) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%D_FDynP,1), UBOUND(OutData%D_FDynP,1) + OutData%D_FDynP(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! L_F_B not allocated Int_Xferred = Int_Xferred + 1 @@ -7808,15 +7673,12 @@ SUBROUTINE Morison_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%L_F_B.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%L_F_B)>0) OutData%L_F_B = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%L_F_B))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%L_F_B) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%L_F_B,2), UBOUND(OutData%L_F_B,2) + DO i1 = LBOUND(OutData%L_F_B,1), UBOUND(OutData%L_F_B,1) + OutData%L_F_B(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! L_F_D not allocated Int_Xferred = Int_Xferred + 1 @@ -7834,15 +7696,12 @@ SUBROUTINE Morison_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%L_F_D.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%L_F_D)>0) OutData%L_F_D = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%L_F_D))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%L_F_D) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%L_F_D,2), UBOUND(OutData%L_F_D,2) + DO i1 = LBOUND(OutData%L_F_D,1), UBOUND(OutData%L_F_D,1) + OutData%L_F_D(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! L_F_I not allocated Int_Xferred = Int_Xferred + 1 @@ -7860,15 +7719,12 @@ SUBROUTINE Morison_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%L_F_I.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%L_F_I)>0) OutData%L_F_I = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%L_F_I))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%L_F_I) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%L_F_I,2), UBOUND(OutData%L_F_I,2) + DO i1 = LBOUND(OutData%L_F_I,1), UBOUND(OutData%L_F_I,1) + OutData%L_F_I(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! L_F_DP not allocated Int_Xferred = Int_Xferred + 1 @@ -7886,15 +7742,12 @@ SUBROUTINE Morison_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%L_F_DP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%L_F_DP)>0) OutData%L_F_DP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%L_F_DP))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%L_F_DP) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%L_F_DP,2), UBOUND(OutData%L_F_DP,2) + DO i1 = LBOUND(OutData%L_F_DP,1), UBOUND(OutData%L_F_DP,1) + OutData%L_F_DP(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! L_F_AM not allocated Int_Xferred = Int_Xferred + 1 @@ -7912,15 +7765,12 @@ SUBROUTINE Morison_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%L_F_AM.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%L_F_AM)>0) OutData%L_F_AM = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%L_F_AM))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%L_F_AM) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%L_F_AM,2), UBOUND(OutData%L_F_AM,2) + DO i1 = LBOUND(OutData%L_F_AM,1), UBOUND(OutData%L_F_AM,1) + OutData%L_F_AM(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! L_FV not allocated Int_Xferred = Int_Xferred + 1 @@ -7938,15 +7788,12 @@ SUBROUTINE Morison_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%L_FV.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%L_FV)>0) OutData%L_FV = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%L_FV))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%L_FV) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%L_FV,2), UBOUND(OutData%L_FV,2) + DO i1 = LBOUND(OutData%L_FV,1), UBOUND(OutData%L_FV,1) + OutData%L_FV(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! L_FA not allocated Int_Xferred = Int_Xferred + 1 @@ -7964,15 +7811,12 @@ SUBROUTINE Morison_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%L_FA.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%L_FA)>0) OutData%L_FA = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%L_FA))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%L_FA) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%L_FA,2), UBOUND(OutData%L_FA,2) + DO i1 = LBOUND(OutData%L_FA,1), UBOUND(OutData%L_FA,1) + OutData%L_FA(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! L_FDynP not allocated Int_Xferred = Int_Xferred + 1 @@ -7987,18 +7831,13 @@ SUBROUTINE Morison_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%L_FDynP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%L_FDynP)>0) OutData%L_FDynP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%L_FDynP))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%L_FDynP) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%L_FDynP,1), UBOUND(OutData%L_FDynP,1) + OutData%L_FDynP(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%LastIndWave = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%LastIndWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Morison_UnPackMisc SUBROUTINE Morison_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -8854,12 +8693,12 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WtrDens - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NNodes - Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDens + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NNodes + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%Nodes) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -8917,8 +8756,14 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_F_I,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D_F_I)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D_F_I))-1 ) = PACK(InData%D_F_I,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D_F_I) + DO i3 = LBOUND(InData%D_F_I,3), UBOUND(InData%D_F_I,3) + DO i2 = LBOUND(InData%D_F_I,2), UBOUND(InData%D_F_I,2) + DO i1 = LBOUND(InData%D_F_I,1), UBOUND(InData%D_F_I,1) + ReKiBuf(Re_Xferred) = InData%D_F_I(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%D_F_DP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8936,8 +8781,14 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_F_DP,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D_F_DP)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D_F_DP))-1 ) = PACK(InData%D_F_DP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D_F_DP) + DO i3 = LBOUND(InData%D_F_DP,3), UBOUND(InData%D_F_DP,3) + DO i2 = LBOUND(InData%D_F_DP,2), UBOUND(InData%D_F_DP,2) + DO i1 = LBOUND(InData%D_F_DP,1), UBOUND(InData%D_F_DP,1) + ReKiBuf(Re_Xferred) = InData%D_F_DP(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%D_dragConst) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8949,8 +8800,10 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_dragConst,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D_dragConst)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D_dragConst))-1 ) = PACK(InData%D_dragConst,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D_dragConst) + DO i1 = LBOUND(InData%D_dragConst,1), UBOUND(InData%D_dragConst,1) + ReKiBuf(Re_Xferred) = InData%D_dragConst(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%L_An) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8965,8 +8818,12 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%L_An,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%L_An)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%L_An))-1 ) = PACK(InData%L_An,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%L_An) + DO i2 = LBOUND(InData%L_An,2), UBOUND(InData%L_An,2) + DO i1 = LBOUND(InData%L_An,1), UBOUND(InData%L_An,1) + ReKiBuf(Re_Xferred) = InData%L_An(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%L_F_B) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -8981,8 +8838,12 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%L_F_B,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%L_F_B)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%L_F_B))-1 ) = PACK(InData%L_F_B,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%L_F_B) + DO i2 = LBOUND(InData%L_F_B,2), UBOUND(InData%L_F_B,2) + DO i1 = LBOUND(InData%L_F_B,1), UBOUND(InData%L_F_B,1) + ReKiBuf(Re_Xferred) = InData%L_F_B(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%L_F_I) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -9000,8 +8861,14 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%L_F_I,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%L_F_I)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%L_F_I))-1 ) = PACK(InData%L_F_I,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%L_F_I) + DO i3 = LBOUND(InData%L_F_I,3), UBOUND(InData%L_F_I,3) + DO i2 = LBOUND(InData%L_F_I,2), UBOUND(InData%L_F_I,2) + DO i1 = LBOUND(InData%L_F_I,1), UBOUND(InData%L_F_I,1) + ReKiBuf(Re_Xferred) = InData%L_F_I(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%L_F_DP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -9019,8 +8886,14 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%L_F_DP,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%L_F_DP)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%L_F_DP))-1 ) = PACK(InData%L_F_DP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%L_F_DP) + DO i3 = LBOUND(InData%L_F_DP,3), UBOUND(InData%L_F_DP,3) + DO i2 = LBOUND(InData%L_F_DP,2), UBOUND(InData%L_F_DP,2) + DO i1 = LBOUND(InData%L_F_DP,1), UBOUND(InData%L_F_DP,1) + ReKiBuf(Re_Xferred) = InData%L_F_DP(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%L_F_BF) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -9035,8 +8908,12 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%L_F_BF,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%L_F_BF)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%L_F_BF))-1 ) = PACK(InData%L_F_BF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%L_F_BF) + DO i2 = LBOUND(InData%L_F_BF,2), UBOUND(InData%L_F_BF,2) + DO i1 = LBOUND(InData%L_F_BF,1), UBOUND(InData%L_F_BF,1) + ReKiBuf(Re_Xferred) = InData%L_F_BF(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%L_AM_M) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -9054,8 +8931,14 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%L_AM_M,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%L_AM_M)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%L_AM_M))-1 ) = PACK(InData%L_AM_M,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%L_AM_M) + DO i3 = LBOUND(InData%L_AM_M,3), UBOUND(InData%L_AM_M,3) + DO i2 = LBOUND(InData%L_AM_M,2), UBOUND(InData%L_AM_M,2) + DO i1 = LBOUND(InData%L_AM_M,1), UBOUND(InData%L_AM_M,1) + ReKiBuf(Re_Xferred) = InData%L_AM_M(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%L_dragConst) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -9067,11 +8950,13 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%L_dragConst,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%L_dragConst)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%L_dragConst))-1 ) = PACK(InData%L_dragConst,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%L_dragConst) + DO i1 = LBOUND(InData%L_dragConst,1), UBOUND(InData%L_dragConst,1) + ReKiBuf(Re_Xferred) = InData%L_dragConst(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NDistribMarkers - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NDistribMarkers + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%distribToNodeIndx) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -9082,11 +8967,13 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%distribToNodeIndx,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%distribToNodeIndx)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%distribToNodeIndx))-1 ) = PACK(InData%distribToNodeIndx,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%distribToNodeIndx) + DO i1 = LBOUND(InData%distribToNodeIndx,1), UBOUND(InData%distribToNodeIndx,1) + IntKiBuf(Int_Xferred) = InData%distribToNodeIndx(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NLumpedMarkers - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NLumpedMarkers + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%lumpedToNodeIndx) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -9097,8 +8984,10 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%lumpedToNodeIndx,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%lumpedToNodeIndx)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%lumpedToNodeIndx))-1 ) = PACK(InData%lumpedToNodeIndx,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%lumpedToNodeIndx) + DO i1 = LBOUND(InData%lumpedToNodeIndx,1), UBOUND(InData%lumpedToNodeIndx,1) + IntKiBuf(Int_Xferred) = InData%lumpedToNodeIndx(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveVel) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -9116,8 +9005,14 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveVel)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveVel))-1 ) = PACK(InData%WaveVel,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveVel) + DO i3 = LBOUND(InData%WaveVel,3), UBOUND(InData%WaveVel,3) + DO i2 = LBOUND(InData%WaveVel,2), UBOUND(InData%WaveVel,2) + DO i1 = LBOUND(InData%WaveVel,1), UBOUND(InData%WaveVel,1) + ReKiBuf(Re_Xferred) = InData%WaveVel(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveAcc) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -9135,8 +9030,14 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveAcc)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveAcc))-1 ) = PACK(InData%WaveAcc,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveAcc) + DO i3 = LBOUND(InData%WaveAcc,3), UBOUND(InData%WaveAcc,3) + DO i2 = LBOUND(InData%WaveAcc,2), UBOUND(InData%WaveAcc,2) + DO i1 = LBOUND(InData%WaveAcc,1), UBOUND(InData%WaveAcc,1) + ReKiBuf(Re_Xferred) = InData%WaveAcc(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveDynP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -9151,8 +9052,12 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveDynP)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveDynP))-1 ) = PACK(InData%WaveDynP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveDynP) + DO i2 = LBOUND(InData%WaveDynP,2), UBOUND(InData%WaveDynP,2) + DO i1 = LBOUND(InData%WaveDynP,1), UBOUND(InData%WaveDynP,1) + ReKiBuf(Re_Xferred) = InData%WaveDynP(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveTime) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -9164,8 +9069,10 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveTime)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveTime))-1 ) = PACK(InData%WaveTime,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveTime) + DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) + ReKiBuf(Re_Xferred) = InData%WaveTime(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%elementWaterState) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -9180,8 +9087,12 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%elementWaterState,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%elementWaterState)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%elementWaterState))-1 ) = PACK(InData%elementWaterState,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%elementWaterState) + DO i2 = LBOUND(InData%elementWaterState,2), UBOUND(InData%elementWaterState,2) + DO i1 = LBOUND(InData%elementWaterState,1), UBOUND(InData%elementWaterState,1) + IntKiBuf(Int_Xferred) = InData%elementWaterState(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%elementFillState) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -9193,8 +9104,10 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%elementFillState,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%elementFillState)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%elementFillState))-1 ) = PACK(InData%elementFillState,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%elementFillState) + DO i1 = LBOUND(InData%elementFillState,1), UBOUND(InData%elementFillState,1) + IntKiBuf(Int_Xferred) = InData%elementFillState(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%nodeInWater) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -9209,8 +9122,12 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%nodeInWater,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%nodeInWater)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%nodeInWater))-1 ) = PACK(InData%nodeInWater,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%nodeInWater) + DO i2 = LBOUND(InData%nodeInWater,2), UBOUND(InData%nodeInWater,2) + DO i1 = LBOUND(InData%nodeInWater,1), UBOUND(InData%nodeInWater,1) + IntKiBuf(Int_Xferred) = InData%nodeInWater(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%D_F_B) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -9225,8 +9142,12 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_F_B,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D_F_B)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D_F_B))-1 ) = PACK(InData%D_F_B,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D_F_B) + DO i2 = LBOUND(InData%D_F_B,2), UBOUND(InData%D_F_B,2) + DO i1 = LBOUND(InData%D_F_B,1), UBOUND(InData%D_F_B,1) + ReKiBuf(Re_Xferred) = InData%D_F_B(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%D_F_BF) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -9241,8 +9162,12 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_F_BF,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D_F_BF)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D_F_BF))-1 ) = PACK(InData%D_F_BF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D_F_BF) + DO i2 = LBOUND(InData%D_F_BF,2), UBOUND(InData%D_F_BF,2) + DO i1 = LBOUND(InData%D_F_BF,1), UBOUND(InData%D_F_BF,1) + ReKiBuf(Re_Xferred) = InData%D_F_BF(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%D_F_MG) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -9257,8 +9182,12 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_F_MG,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D_F_MG)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D_F_MG))-1 ) = PACK(InData%D_F_MG,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D_F_MG) + DO i2 = LBOUND(InData%D_F_MG,2), UBOUND(InData%D_F_MG,2) + DO i1 = LBOUND(InData%D_F_MG,1), UBOUND(InData%D_F_MG,1) + ReKiBuf(Re_Xferred) = InData%D_F_MG(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%D_AM_M) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -9276,8 +9205,14 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_AM_M,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D_AM_M)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D_AM_M))-1 ) = PACK(InData%D_AM_M,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D_AM_M) + DO i3 = LBOUND(InData%D_AM_M,3), UBOUND(InData%D_AM_M,3) + DO i2 = LBOUND(InData%D_AM_M,2), UBOUND(InData%D_AM_M,2) + DO i1 = LBOUND(InData%D_AM_M,1), UBOUND(InData%D_AM_M,1) + ReKiBuf(Re_Xferred) = InData%D_AM_M(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%D_AM_MG) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -9289,8 +9224,10 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_AM_MG,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D_AM_MG)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D_AM_MG))-1 ) = PACK(InData%D_AM_MG,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D_AM_MG) + DO i1 = LBOUND(InData%D_AM_MG,1), UBOUND(InData%D_AM_MG,1) + ReKiBuf(Re_Xferred) = InData%D_AM_MG(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%D_AM_F) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -9302,13 +9239,15 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D_AM_F,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D_AM_F)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D_AM_F))-1 ) = PACK(InData%D_AM_F,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D_AM_F) + DO i1 = LBOUND(InData%D_AM_F,1), UBOUND(InData%D_AM_F,1) + ReKiBuf(Re_Xferred) = InData%D_AM_F(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NMOutputs - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepWave + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NMOutputs + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%MOutLst) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -9350,8 +9289,8 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs ENDIF END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NJOutputs - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NJOutputs + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%JOutLst) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -9434,26 +9373,26 @@ SUBROUTINE Morison_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs ENDIF END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOutAll - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%OutSwtch - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UnOutFile - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%OutSFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutSFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%Delim) - IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOutAll + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%OutSwtch + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%UnOutFile + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%OutFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%OutSFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutSFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%Delim) + IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE Morison_PackParam SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -9469,12 +9408,6 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (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 @@ -9491,12 +9424,12 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%WtrDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NNodes = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%WtrDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NNodes = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Nodes not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -9572,15 +9505,14 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_F_I.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%D_F_I)>0) OutData%D_F_I = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D_F_I))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D_F_I) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%D_F_I,3), UBOUND(OutData%D_F_I,3) + DO i2 = LBOUND(OutData%D_F_I,2), UBOUND(OutData%D_F_I,2) + DO i1 = LBOUND(OutData%D_F_I,1), UBOUND(OutData%D_F_I,1) + OutData%D_F_I(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D_F_DP not allocated Int_Xferred = Int_Xferred + 1 @@ -9601,15 +9533,14 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_F_DP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%D_F_DP)>0) OutData%D_F_DP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D_F_DP))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D_F_DP) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%D_F_DP,3), UBOUND(OutData%D_F_DP,3) + DO i2 = LBOUND(OutData%D_F_DP,2), UBOUND(OutData%D_F_DP,2) + DO i1 = LBOUND(OutData%D_F_DP,1), UBOUND(OutData%D_F_DP,1) + OutData%D_F_DP(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D_dragConst not allocated Int_Xferred = Int_Xferred + 1 @@ -9624,15 +9555,10 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_dragConst.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%D_dragConst)>0) OutData%D_dragConst = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D_dragConst))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D_dragConst) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%D_dragConst,1), UBOUND(OutData%D_dragConst,1) + OutData%D_dragConst(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! L_An not allocated Int_Xferred = Int_Xferred + 1 @@ -9650,15 +9576,12 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%L_An.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%L_An)>0) OutData%L_An = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%L_An))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%L_An) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%L_An,2), UBOUND(OutData%L_An,2) + DO i1 = LBOUND(OutData%L_An,1), UBOUND(OutData%L_An,1) + OutData%L_An(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! L_F_B not allocated Int_Xferred = Int_Xferred + 1 @@ -9676,15 +9599,12 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%L_F_B.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%L_F_B)>0) OutData%L_F_B = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%L_F_B))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%L_F_B) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%L_F_B,2), UBOUND(OutData%L_F_B,2) + DO i1 = LBOUND(OutData%L_F_B,1), UBOUND(OutData%L_F_B,1) + OutData%L_F_B(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! L_F_I not allocated Int_Xferred = Int_Xferred + 1 @@ -9705,15 +9625,14 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%L_F_I.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%L_F_I)>0) OutData%L_F_I = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%L_F_I))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%L_F_I) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%L_F_I,3), UBOUND(OutData%L_F_I,3) + DO i2 = LBOUND(OutData%L_F_I,2), UBOUND(OutData%L_F_I,2) + DO i1 = LBOUND(OutData%L_F_I,1), UBOUND(OutData%L_F_I,1) + OutData%L_F_I(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 ! L_F_DP not allocated Int_Xferred = Int_Xferred + 1 @@ -9734,15 +9653,14 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%L_F_DP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%L_F_DP)>0) OutData%L_F_DP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%L_F_DP))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%L_F_DP) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%L_F_DP,3), UBOUND(OutData%L_F_DP,3) + DO i2 = LBOUND(OutData%L_F_DP,2), UBOUND(OutData%L_F_DP,2) + DO i1 = LBOUND(OutData%L_F_DP,1), UBOUND(OutData%L_F_DP,1) + OutData%L_F_DP(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 ! L_F_BF not allocated Int_Xferred = Int_Xferred + 1 @@ -9760,15 +9678,12 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%L_F_BF.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%L_F_BF)>0) OutData%L_F_BF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%L_F_BF))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%L_F_BF) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%L_F_BF,2), UBOUND(OutData%L_F_BF,2) + DO i1 = LBOUND(OutData%L_F_BF,1), UBOUND(OutData%L_F_BF,1) + OutData%L_F_BF(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! L_AM_M not allocated Int_Xferred = Int_Xferred + 1 @@ -9789,15 +9704,14 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%L_AM_M.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%L_AM_M)>0) OutData%L_AM_M = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%L_AM_M))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%L_AM_M) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%L_AM_M,3), UBOUND(OutData%L_AM_M,3) + DO i2 = LBOUND(OutData%L_AM_M,2), UBOUND(OutData%L_AM_M,2) + DO i1 = LBOUND(OutData%L_AM_M,1), UBOUND(OutData%L_AM_M,1) + OutData%L_AM_M(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 ! L_dragConst not allocated Int_Xferred = Int_Xferred + 1 @@ -9812,18 +9726,13 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%L_dragConst.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%L_dragConst)>0) OutData%L_dragConst = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%L_dragConst))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%L_dragConst) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%L_dragConst,1), UBOUND(OutData%L_dragConst,1) + OutData%L_dragConst(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%NDistribMarkers = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NDistribMarkers = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! distribToNodeIndx not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -9837,18 +9746,13 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%distribToNodeIndx.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%distribToNodeIndx)>0) OutData%distribToNodeIndx = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%distribToNodeIndx))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%distribToNodeIndx) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%distribToNodeIndx,1), UBOUND(OutData%distribToNodeIndx,1) + OutData%distribToNodeIndx(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF - OutData%NLumpedMarkers = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NLumpedMarkers = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! lumpedToNodeIndx not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -9862,15 +9766,10 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%lumpedToNodeIndx.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%lumpedToNodeIndx)>0) OutData%lumpedToNodeIndx = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%lumpedToNodeIndx))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%lumpedToNodeIndx) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%lumpedToNodeIndx,1), UBOUND(OutData%lumpedToNodeIndx,1) + OutData%lumpedToNodeIndx(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveVel not allocated Int_Xferred = Int_Xferred + 1 @@ -9891,15 +9790,14 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%WaveVel)>0) OutData%WaveVel = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveVel))-1 ), mask3, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveVel) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%WaveVel,3), UBOUND(OutData%WaveVel,3) + DO i2 = LBOUND(OutData%WaveVel,2), UBOUND(OutData%WaveVel,2) + DO i1 = LBOUND(OutData%WaveVel,1), UBOUND(OutData%WaveVel,1) + OutData%WaveVel(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAcc not allocated Int_Xferred = Int_Xferred + 1 @@ -9920,15 +9818,14 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%WaveAcc)>0) OutData%WaveAcc = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveAcc))-1 ), mask3, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveAcc) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%WaveAcc,3), UBOUND(OutData%WaveAcc,3) + DO i2 = LBOUND(OutData%WaveAcc,2), UBOUND(OutData%WaveAcc,2) + DO i1 = LBOUND(OutData%WaveAcc,1), UBOUND(OutData%WaveAcc,1) + OutData%WaveAcc(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDynP not allocated Int_Xferred = Int_Xferred + 1 @@ -9946,15 +9843,12 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveDynP)>0) OutData%WaveDynP = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveDynP))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveDynP) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveDynP,2), UBOUND(OutData%WaveDynP,2) + DO i1 = LBOUND(OutData%WaveDynP,1), UBOUND(OutData%WaveDynP,1) + OutData%WaveDynP(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated Int_Xferred = Int_Xferred + 1 @@ -9969,15 +9863,10 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveTime)>0) OutData%WaveTime = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveTime))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveTime) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) + OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! elementWaterState not allocated Int_Xferred = Int_Xferred + 1 @@ -9995,15 +9884,12 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%elementWaterState.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%elementWaterState)>0) OutData%elementWaterState = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%elementWaterState))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%elementWaterState) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%elementWaterState,2), UBOUND(OutData%elementWaterState,2) + DO i1 = LBOUND(OutData%elementWaterState,1), UBOUND(OutData%elementWaterState,1) + OutData%elementWaterState(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! elementFillState not allocated Int_Xferred = Int_Xferred + 1 @@ -10018,15 +9904,10 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%elementFillState.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%elementFillState)>0) OutData%elementFillState = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%elementFillState))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%elementFillState) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%elementFillState,1), UBOUND(OutData%elementFillState,1) + OutData%elementFillState(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! nodeInWater not allocated Int_Xferred = Int_Xferred + 1 @@ -10044,15 +9925,12 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%nodeInWater.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%nodeInWater)>0) OutData%nodeInWater = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%nodeInWater))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%nodeInWater) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%nodeInWater,2), UBOUND(OutData%nodeInWater,2) + DO i1 = LBOUND(OutData%nodeInWater,1), UBOUND(OutData%nodeInWater,1) + OutData%nodeInWater(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D_F_B not allocated Int_Xferred = Int_Xferred + 1 @@ -10070,15 +9948,12 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_F_B.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%D_F_B)>0) OutData%D_F_B = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D_F_B))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D_F_B) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%D_F_B,2), UBOUND(OutData%D_F_B,2) + DO i1 = LBOUND(OutData%D_F_B,1), UBOUND(OutData%D_F_B,1) + OutData%D_F_B(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D_F_BF not allocated Int_Xferred = Int_Xferred + 1 @@ -10096,15 +9971,12 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_F_BF.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%D_F_BF)>0) OutData%D_F_BF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D_F_BF))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D_F_BF) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%D_F_BF,2), UBOUND(OutData%D_F_BF,2) + DO i1 = LBOUND(OutData%D_F_BF,1), UBOUND(OutData%D_F_BF,1) + OutData%D_F_BF(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D_F_MG not allocated Int_Xferred = Int_Xferred + 1 @@ -10122,15 +9994,12 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_F_MG.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%D_F_MG)>0) OutData%D_F_MG = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D_F_MG))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D_F_MG) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%D_F_MG,2), UBOUND(OutData%D_F_MG,2) + DO i1 = LBOUND(OutData%D_F_MG,1), UBOUND(OutData%D_F_MG,1) + OutData%D_F_MG(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D_AM_M not allocated Int_Xferred = Int_Xferred + 1 @@ -10151,15 +10020,14 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_AM_M.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%D_AM_M)>0) OutData%D_AM_M = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D_AM_M))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D_AM_M) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%D_AM_M,3), UBOUND(OutData%D_AM_M,3) + DO i2 = LBOUND(OutData%D_AM_M,2), UBOUND(OutData%D_AM_M,2) + DO i1 = LBOUND(OutData%D_AM_M,1), UBOUND(OutData%D_AM_M,1) + OutData%D_AM_M(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D_AM_MG not allocated Int_Xferred = Int_Xferred + 1 @@ -10174,15 +10042,10 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_AM_MG.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%D_AM_MG)>0) OutData%D_AM_MG = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D_AM_MG))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D_AM_MG) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%D_AM_MG,1), UBOUND(OutData%D_AM_MG,1) + OutData%D_AM_MG(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D_AM_F not allocated Int_Xferred = Int_Xferred + 1 @@ -10197,20 +10060,15 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D_AM_F.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%D_AM_F)>0) OutData%D_AM_F = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D_AM_F))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D_AM_F) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%D_AM_F,1), UBOUND(OutData%D_AM_F,1) + OutData%D_AM_F(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%NStepWave = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NMOutputs = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NStepWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NMOutputs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MOutLst not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -10267,8 +10125,8 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%NJOutputs = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NJOutputs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! JOutLst not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -10381,26 +10239,26 @@ SUBROUTINE Morison_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumOutAll = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%OutSwtch = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%UnOutFile = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutFmt) - OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%OutSFmt) - OutData%OutSFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Delim) - OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumOutAll = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%OutSwtch = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%UnOutFile = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%OutFmt) + OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%OutSFmt) + OutData%OutSFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%Delim) + OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE Morison_UnPackParam SUBROUTINE Morison_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -10606,12 +10464,6 @@ SUBROUTINE Morison_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Morison_UnPackInput' @@ -10926,8 +10778,10 @@ SUBROUTINE Morison_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WriteOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WriteOutput))-1 ) = PACK(InData%WriteOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WriteOutput) + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE Morison_PackOutput @@ -10944,12 +10798,6 @@ SUBROUTINE Morison_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -11057,15 +10905,10 @@ SUBROUTINE Morison_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WriteOutput)>0) OutData%WriteOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WriteOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WriteOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE Morison_UnPackOutput @@ -11144,8 +10987,8 @@ SUBROUTINE Morison_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, Err REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'Morison_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -11160,6 +11003,8 @@ SUBROUTINE Morison_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(u1%DistribMesh, u2%DistribMesh, tin, u_out%DistribMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL MeshExtrapInterp1(u1%LumpedMesh, u2%LumpedMesh, tin, u_out%LumpedMesh, tin_out, ErrStat2, ErrMsg2 ) @@ -11193,8 +11038,9 @@ SUBROUTINE Morison_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'Morison_Input_ExtrapInterp2' @@ -11216,6 +11062,8 @@ SUBROUTINE Morison_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(u1%DistribMesh, u2%DistribMesh, u3%DistribMesh, tin, u_out%DistribMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL MeshExtrapInterp2(u1%LumpedMesh, u2%LumpedMesh, u3%LumpedMesh, tin, u_out%LumpedMesh, tin_out, ErrStat2, ErrMsg2 ) @@ -11297,12 +11145,12 @@ SUBROUTINE Morison_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, Er REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'Morison_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -11315,17 +11163,17 @@ SUBROUTINE Morison_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(y1%DistribMesh, y2%DistribMesh, tin, y_out%DistribMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL MeshExtrapInterp1(y1%LumpedMesh, y2%LumpedMesh, tin, y_out%LumpedMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = -(y1%WriteOutput - y2%WriteOutput)/t(2) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO END IF ! check if allocated END SUBROUTINE Morison_Output_ExtrapInterp1 @@ -11356,13 +11204,14 @@ SUBROUTINE Morison_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'Morison_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -11381,18 +11230,18 @@ SUBROUTINE Morison_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(y1%DistribMesh, y2%DistribMesh, y3%DistribMesh, tin, y_out%DistribMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL MeshExtrapInterp2(y1%LumpedMesh, y2%LumpedMesh, y3%LumpedMesh, tin, y_out%LumpedMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = (t(3)**2*(y1%WriteOutput - y2%WriteOutput) + t(2)**2*(-y1%WriteOutput + y3%WriteOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WriteOutput + t(3)*y2%WriteOutput - t(2)*y3%WriteOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO END IF ! check if allocated END SUBROUTINE Morison_Output_ExtrapInterp2 diff --git a/modules/hydrodyn/src/SS_Excitation.f90 b/modules/hydrodyn/src/SS_Excitation.f90 index 6e026270a6..f2071c1db1 100644 --- a/modules/hydrodyn/src/SS_Excitation.f90 +++ b/modules/hydrodyn/src/SS_Excitation.f90 @@ -87,8 +87,8 @@ SUBROUTINE SS_Exc_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Ini character(ErrMsgLen) :: ErrMsg2 ! Initialize ErrStat - ErrStat = ErrID_None - ErrMsg = "" + ErrStat = ErrID_None + ErrMsg = "" u%DummyInput = 0.0_ReKi @@ -110,7 +110,7 @@ SUBROUTINE SS_Exc_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Ini CALL ReadCom ( UnSS, TRIM(InitInp%InputFile)//'.ssexctn', 'Header',ErrStat2, ErrMsg2 )! Reads the first entire line (Title header) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SS_Exc_Init') - CALL ReadVar( UnSS,TRIM(InitInp%InputFile)//'.ssexctn', WaveDir, 'WaveDir', 'Wave direction (deg)',ErrStat2, ErrMsg2) ! Reads in the third line, containing the number of states + CALL ReadVar( UnSS,TRIM(InitInp%InputFile)//'.ssexctn', WaveDir, 'WaveDir', 'Wave direction (deg)',ErrStat2, ErrMsg2) ! Reads in the second line, containing the wave direction CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,'SS_Exc_Init') ! Check that excitation state-space file Beta angle (in degrees) matches the HydroDyn input file angle diff --git a/modules/hydrodyn/src/SS_Excitation.txt b/modules/hydrodyn/src/SS_Excitation.txt index 5bc4f67c99..1c98d4948b 100644 --- a/modules/hydrodyn/src/SS_Excitation.txt +++ b/modules/hydrodyn/src/SS_Excitation.txt @@ -24,7 +24,7 @@ typedef ^ ^ SiKi WaveTime {:} typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputHdr {7} - - "Header of the output" - typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputUnt {7} - - "Units of the output" - -typedef ^ ContinuousStateType ReKi x {:} - - "Continuous States" - +typedef ^ ContinuousStateType R8Ki x {:} - - "Continuous States" - typedef ^ DiscreteStateType SiKi DummyDiscState - - - "" - diff --git a/modules/hydrodyn/src/SS_Excitation_Types.f90 b/modules/hydrodyn/src/SS_Excitation_Types.f90 index d495950017..10966b9c6e 100644 --- a/modules/hydrodyn/src/SS_Excitation_Types.f90 +++ b/modules/hydrodyn/src/SS_Excitation_Types.f90 @@ -50,7 +50,7 @@ MODULE SS_Excitation_Types ! ======================= ! ========= SS_Exc_ContinuousStateType ======= TYPE, PUBLIC :: SS_Exc_ContinuousStateType - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: x !< Continuous States [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: x !< Continuous States [-] END TYPE SS_Exc_ContinuousStateType ! ======================= ! ========= SS_Exc_DiscreteStateType ======= @@ -237,14 +237,14 @@ SUBROUTINE SS_Exc_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WaveDir - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%InputFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + ReKiBuf(Re_Xferred) = InData%WaveDir + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepWave + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WaveElev0) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -255,8 +255,10 @@ SUBROUTINE SS_Exc_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev0,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElev0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElev0))-1 ) = PACK(InData%WaveElev0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElev0) + DO i1 = LBOUND(InData%WaveElev0,1), UBOUND(InData%WaveElev0,1) + ReKiBuf(Re_Xferred) = InData%WaveElev0(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveTime) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -268,8 +270,10 @@ SUBROUTINE SS_Exc_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveTime)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveTime))-1 ) = PACK(InData%WaveTime,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveTime) + DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) + ReKiBuf(Re_Xferred) = InData%WaveTime(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE SS_Exc_PackInitInput @@ -286,12 +290,6 @@ SUBROUTINE SS_Exc_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -307,14 +305,14 @@ SUBROUTINE SS_Exc_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%InputFile) - OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%WaveDir = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NStepWave = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%InputFile) + OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%WaveDir = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NStepWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev0 not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -328,15 +326,10 @@ SUBROUTINE SS_Exc_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveElev0)>0) OutData%WaveElev0 = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElev0))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElev0) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveElev0,1), UBOUND(OutData%WaveElev0,1) + OutData%WaveElev0(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated Int_Xferred = Int_Xferred + 1 @@ -351,15 +344,10 @@ SUBROUTINE SS_Exc_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveTime)>0) OutData%WaveTime = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveTime))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveTime) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) + OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE SS_Exc_UnPackInitInput @@ -458,17 +446,17 @@ SUBROUTINE SS_Exc_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_Xferred = 1 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 !i1 + 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 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 !i1 + 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 SUBROUTINE SS_Exc_PackInitOutput SUBROUTINE SS_Exc_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -484,12 +472,6 @@ SUBROUTINE SS_Exc_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -506,34 +488,20 @@ SUBROUTINE SS_Exc_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Xferred = 1 i1_l = LBOUND(OutData%WriteOutputHdr,1) i1_u = UBOUND(OutData%WriteOutputHdr,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. 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 !i1 - DEALLOCATE(mask1) + 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 i1_l = LBOUND(OutData%WriteOutputUnt,1) i1_u = UBOUND(OutData%WriteOutputUnt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. 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 !i1 - DEALLOCATE(mask1) + 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 SUBROUTINE SS_Exc_UnPackInitOutput SUBROUTINE SS_Exc_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) @@ -617,7 +585,7 @@ SUBROUTINE SS_Exc_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Int_BufSz = Int_BufSz + 1 ! x allocated yes/no IF ( ALLOCATED(InData%x) ) THEN Int_BufSz = Int_BufSz + 2*1 ! x upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%x) ! x + Db_BufSz = Db_BufSz + SIZE(InData%x) ! x END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) @@ -656,8 +624,10 @@ SUBROUTINE SS_Exc_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%x)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%x))-1 ) = PACK(InData%x,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%x) + DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) + DbKiBuf(Db_Xferred) = InData%x(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF END SUBROUTINE SS_Exc_PackContState @@ -674,12 +644,6 @@ SUBROUTINE SS_Exc_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -707,15 +671,10 @@ SUBROUTINE SS_Exc_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%x)>0) OutData%x = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%x))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%x) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) + OutData%x(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO END IF END SUBROUTINE SS_Exc_UnPackContState @@ -810,8 +769,8 @@ SUBROUTINE SS_Exc_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyDiscState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyDiscState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE SS_Exc_PackDiscState SUBROUTINE SS_Exc_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -827,12 +786,6 @@ SUBROUTINE SS_Exc_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_UnPackDiscState' @@ -846,8 +799,8 @@ SUBROUTINE SS_Exc_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyDiscState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyDiscState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE SS_Exc_UnPackDiscState SUBROUTINE SS_Exc_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) @@ -941,8 +894,8 @@ SUBROUTINE SS_Exc_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyConstrState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE SS_Exc_PackConstrState SUBROUTINE SS_Exc_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -958,12 +911,6 @@ SUBROUTINE SS_Exc_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_UnPackConstrState' @@ -977,8 +924,8 @@ SUBROUTINE SS_Exc_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyConstrState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyConstrState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE SS_Exc_UnPackConstrState SUBROUTINE SS_Exc_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -1101,8 +1048,8 @@ SUBROUTINE SS_Exc_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%n - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%n + Int_Xferred = Int_Xferred + 1 DO i1 = LBOUND(InData%xdot,1), UBOUND(InData%xdot,1) CALL SS_Exc_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xdot(i1), ErrStat2, ErrMsg2, OnlySize ) ! xdot CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1148,12 +1095,6 @@ SUBROUTINE SS_Exc_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1168,8 +1109,8 @@ SUBROUTINE SS_Exc_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%n = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%n = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%xdot,1) i1_u = UBOUND(OutData%xdot,1) DO i1 = LBOUND(OutData%xdot,1), UBOUND(OutData%xdot,1) @@ -1307,8 +1248,8 @@ SUBROUTINE SS_Exc_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%LastIndWave - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%LastIndWave + Int_Xferred = Int_Xferred + 1 END SUBROUTINE SS_Exc_PackMisc SUBROUTINE SS_Exc_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1324,12 +1265,6 @@ SUBROUTINE SS_Exc_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_UnPackMisc' @@ -1343,8 +1278,8 @@ SUBROUTINE SS_Exc_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%LastIndWave = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%LastIndWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE SS_Exc_UnPackMisc SUBROUTINE SS_Exc_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -1552,12 +1487,14 @@ SUBROUTINE SS_Exc_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%spDOF))-1 ) = PACK(InData%spDOF,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%spDOF) + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepWave + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%spDOF,1), UBOUND(InData%spDOF,1) + IntKiBuf(Int_Xferred) = InData%spDOF(i1) + Int_Xferred = Int_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%A) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1571,8 +1508,12 @@ SUBROUTINE SS_Exc_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%A,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%A)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%A))-1 ) = PACK(InData%A,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%A) + DO i2 = LBOUND(InData%A,2), UBOUND(InData%A,2) + DO i1 = LBOUND(InData%A,1), UBOUND(InData%A,1) + ReKiBuf(Re_Xferred) = InData%A(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%B) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1584,8 +1525,10 @@ SUBROUTINE SS_Exc_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%B,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%B)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%B))-1 ) = PACK(InData%B,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%B) + DO i1 = LBOUND(InData%B,1), UBOUND(InData%B,1) + ReKiBuf(Re_Xferred) = InData%B(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%C) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1600,13 +1543,17 @@ SUBROUTINE SS_Exc_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%C)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%C))-1 ) = PACK(InData%C,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%C) + DO i2 = LBOUND(InData%C,2), UBOUND(InData%C,2) + DO i1 = LBOUND(InData%C,1), UBOUND(InData%C,1) + ReKiBuf(Re_Xferred) = InData%C(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%N - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%Tc - Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%N + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%Tc + Db_Xferred = Db_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WaveElev0) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1617,8 +1564,10 @@ SUBROUTINE SS_Exc_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev0,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElev0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElev0))-1 ) = PACK(InData%WaveElev0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElev0) + DO i1 = LBOUND(InData%WaveElev0,1), UBOUND(InData%WaveElev0,1) + ReKiBuf(Re_Xferred) = InData%WaveElev0(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveTime) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1630,8 +1579,10 @@ SUBROUTINE SS_Exc_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveTime)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveTime))-1 ) = PACK(InData%WaveTime,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveTime) + DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) + ReKiBuf(Re_Xferred) = InData%WaveTime(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE SS_Exc_PackParam @@ -1648,12 +1599,6 @@ SUBROUTINE SS_Exc_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -1669,21 +1614,16 @@ SUBROUTINE SS_Exc_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%NStepWave = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%NStepWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%spDOF,1) i1_u = UBOUND(OutData%spDOF,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%spDOF = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%spDOF))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%spDOF) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%spDOF,1), UBOUND(OutData%spDOF,1) + OutData%spDOF(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! A not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1700,15 +1640,12 @@ SUBROUTINE SS_Exc_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%A.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%A)>0) OutData%A = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%A))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%A) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%A,2), UBOUND(OutData%A,2) + DO i1 = LBOUND(OutData%A,1), UBOUND(OutData%A,1) + OutData%A(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! B not allocated Int_Xferred = Int_Xferred + 1 @@ -1723,15 +1660,10 @@ SUBROUTINE SS_Exc_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%B.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%B)>0) OutData%B = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%B))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%B) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%B,1), UBOUND(OutData%B,1) + OutData%B(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C not allocated Int_Xferred = Int_Xferred + 1 @@ -1749,20 +1681,17 @@ SUBROUTINE SS_Exc_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%C)>0) OutData%C = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%C))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%C) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%C,2), UBOUND(OutData%C,2) + DO i1 = LBOUND(OutData%C,1), UBOUND(OutData%C,1) + OutData%C(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - OutData%N = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%Tc = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%N = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%Tc = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev0 not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1776,15 +1705,10 @@ SUBROUTINE SS_Exc_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveElev0)>0) OutData%WaveElev0 = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElev0))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElev0) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveElev0,1), UBOUND(OutData%WaveElev0,1) + OutData%WaveElev0(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated Int_Xferred = Int_Xferred + 1 @@ -1799,15 +1723,10 @@ SUBROUTINE SS_Exc_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveTime)>0) OutData%WaveTime = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveTime))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveTime) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) + OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE SS_Exc_UnPackParam @@ -1902,8 +1821,8 @@ SUBROUTINE SS_Exc_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyInput - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyInput + Re_Xferred = Re_Xferred + 1 END SUBROUTINE SS_Exc_PackInput SUBROUTINE SS_Exc_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1919,12 +1838,6 @@ SUBROUTINE SS_Exc_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_UnPackInput' @@ -1938,8 +1851,8 @@ SUBROUTINE SS_Exc_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyInput = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyInput = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE SS_Exc_UnPackInput SUBROUTINE SS_Exc_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -2036,10 +1949,14 @@ SUBROUTINE SS_Exc_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%y))-1 ) = PACK(InData%y,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%y) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WriteOutput))-1 ) = PACK(InData%WriteOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WriteOutput) + DO i1 = LBOUND(InData%y,1), UBOUND(InData%y,1) + ReKiBuf(Re_Xferred) = InData%y(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE SS_Exc_PackOutput SUBROUTINE SS_Exc_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2055,12 +1972,6 @@ SUBROUTINE SS_Exc_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -2077,26 +1988,16 @@ SUBROUTINE SS_Exc_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Int_Xferred = 1 i1_l = LBOUND(OutData%y,1) i1_u = UBOUND(OutData%y,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%y = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%y))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%y) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%y,1), UBOUND(OutData%y,1) + OutData%y(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%WriteOutput,1) i1_u = UBOUND(OutData%WriteOutput,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%WriteOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WriteOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WriteOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE SS_Exc_UnPackOutput @@ -2174,8 +2075,8 @@ SUBROUTINE SS_Exc_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrM REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -2190,8 +2091,10 @@ SUBROUTINE SS_Exc_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - b0 = -(u1%DummyInput - u2%DummyInput)/t(2) - u_out%DummyInput = u1%DummyInput + b0 * t_out + + ScaleFactor = t_out / t(2) + b = -(u1%DummyInput - u2%DummyInput) + u_out%DummyInput = u1%DummyInput + b * ScaleFactor END SUBROUTINE SS_Exc_Input_ExtrapInterp1 @@ -2221,8 +2124,9 @@ SUBROUTINE SS_Exc_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_Input_ExtrapInterp2' @@ -2244,9 +2148,11 @@ SUBROUTINE SS_Exc_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - b0 = (t(3)**2*(u1%DummyInput - u2%DummyInput) + t(2)**2*(-u1%DummyInput + u3%DummyInput))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%DummyInput + t(3)*u2%DummyInput - t(2)*u3%DummyInput ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%DummyInput = u1%DummyInput + b0 * t_out + c0 * t_out**2 + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) + b = (t(3)**2*(u1%DummyInput - u2%DummyInput) + t(2)**2*(-u1%DummyInput + u3%DummyInput))* scaleFactor + c = ( (t(2)-t(3))*u1%DummyInput + t(3)*u2%DummyInput - t(2)*u3%DummyInput ) * scaleFactor + u_out%DummyInput = u1%DummyInput + b + c * t_out END SUBROUTINE SS_Exc_Input_ExtrapInterp2 @@ -2324,12 +2230,12 @@ SUBROUTINE SS_Exc_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, Err REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -2342,18 +2248,16 @@ SUBROUTINE SS_Exc_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(b1(SIZE(y_out%y,1))) - ALLOCATE(c1(SIZE(y_out%y,1))) - b1 = -(y1%y - y2%y)/t(2) - y_out%y = y1%y + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = -(y1%WriteOutput - y2%WriteOutput)/t(2) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + + ScaleFactor = t_out / t(2) + DO i1 = LBOUND(y_out%y,1),UBOUND(y_out%y,1) + b = -(y1%y(i1) - y2%y(i1)) + y_out%y(i1) = y1%y(i1) + b * ScaleFactor + END DO + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO END SUBROUTINE SS_Exc_Output_ExtrapInterp1 @@ -2383,13 +2287,14 @@ SUBROUTINE SS_Exc_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'SS_Exc_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -2408,20 +2313,18 @@ SUBROUTINE SS_Exc_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(b1(SIZE(y_out%y,1))) - ALLOCATE(c1(SIZE(y_out%y,1))) - b1 = (t(3)**2*(y1%y - y2%y) + t(2)**2*(-y1%y + y3%y))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%y + t(3)*y2%y - t(2)*y3%y ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%y = y1%y + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = (t(3)**2*(y1%WriteOutput - y2%WriteOutput) + t(2)**2*(-y1%WriteOutput + y3%WriteOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WriteOutput + t(3)*y2%WriteOutput - t(2)*y3%WriteOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) + DO i1 = LBOUND(y_out%y,1),UBOUND(y_out%y,1) + b = (t(3)**2*(y1%y(i1) - y2%y(i1)) + t(2)**2*(-y1%y(i1) + y3%y(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%y(i1) + t(3)*y2%y(i1) - t(2)*y3%y(i1) ) * scaleFactor + y_out%y(i1) = y1%y(i1) + b + c * t_out + END DO + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO END SUBROUTINE SS_Exc_Output_ExtrapInterp2 END MODULE SS_Excitation_Types diff --git a/modules/hydrodyn/src/SS_Radiation.f90 b/modules/hydrodyn/src/SS_Radiation.f90 index 4a2525d1a1..62a9b873d1 100644 --- a/modules/hydrodyn/src/SS_Radiation.f90 +++ b/modules/hydrodyn/src/SS_Radiation.f90 @@ -552,7 +552,7 @@ END SUBROUTINE SS_Rad_CalcConstrStateResidual !! !! For details, see: !! Press, W. H.; Flannery, B. P.; Teukolsky, S. A.; and Vetterling, W. T. "Runge-Kutta Method" and "Adaptive Step Size Control for -!! Runge-Kutta." �16.1 and 16.2 in Numerical Recipes in FORTRAN: The Art of Scientific Computing, 2nd ed. Cambridge, England: +!! Runge-Kutta."Sections 16.1 and 16.2 in Numerical Recipes in FORTRAN: The Art of Scientific Computing, 2nd ed. Cambridge, England: !! Cambridge University Press, pp. 704-716, 1992. !! SUBROUTINE SS_Rad_RK4( t, n, u, utimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) diff --git a/modules/hydrodyn/src/SS_Radiation.txt b/modules/hydrodyn/src/SS_Radiation.txt index e60e839448..1d8866dea8 100644 --- a/modules/hydrodyn/src/SS_Radiation.txt +++ b/modules/hydrodyn/src/SS_Radiation.txt @@ -17,7 +17,7 @@ typedef ^ ^ ReKi DOFs {1}{6} - - "Vector typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputHdr {7} - - "Header of the output" - typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputUnt {7} - - "Units of the output" - -typedef ^ ContinuousStateType ReKi x {:} - - "Continuous States" - +typedef ^ ContinuousStateType R8Ki x {:} - - "Continuous States" - typedef ^ DiscreteStateType SiKi DummyDiscState - - - "" - diff --git a/modules/hydrodyn/src/SS_Radiation_Types.f90 b/modules/hydrodyn/src/SS_Radiation_Types.f90 index b61a5c4ac6..39cd178705 100644 --- a/modules/hydrodyn/src/SS_Radiation_Types.f90 +++ b/modules/hydrodyn/src/SS_Radiation_Types.f90 @@ -47,7 +47,7 @@ MODULE SS_Radiation_Types ! ======================= ! ========= SS_Rad_ContinuousStateType ======= TYPE, PUBLIC :: SS_Rad_ContinuousStateType - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: x !< Continuous States [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: x !< Continuous States [-] END TYPE SS_Rad_ContinuousStateType ! ======================= ! ========= SS_Rad_DiscreteStateType ======= @@ -188,12 +188,16 @@ SUBROUTINE SS_Rad_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%DOFs))-1 ) = PACK(InData%DOFs,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%DOFs) + DO I = 1, LEN(InData%InputFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO i2 = LBOUND(InData%DOFs,2), UBOUND(InData%DOFs,2) + DO i1 = LBOUND(InData%DOFs,1), UBOUND(InData%DOFs,1) + ReKiBuf(Re_Xferred) = InData%DOFs(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END SUBROUTINE SS_Rad_PackInitInput SUBROUTINE SS_Rad_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -209,12 +213,6 @@ SUBROUTINE SS_Rad_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -230,23 +228,20 @@ SUBROUTINE SS_Rad_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%InputFile) - OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%InputFile) + OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I i1_l = LBOUND(OutData%DOFs,1) i1_u = UBOUND(OutData%DOFs,1) i2_l = LBOUND(OutData%DOFs,2) i2_u = UBOUND(OutData%DOFs,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%DOFs = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%DOFs))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%DOFs) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%DOFs,2), UBOUND(OutData%DOFs,2) + DO i1 = LBOUND(OutData%DOFs,1), UBOUND(OutData%DOFs,1) + OutData%DOFs(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END SUBROUTINE SS_Rad_UnPackInitInput SUBROUTINE SS_Rad_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -344,17 +339,17 @@ SUBROUTINE SS_Rad_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_Xferred = 1 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 !i1 + 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 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 !i1 + 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 SUBROUTINE SS_Rad_PackInitOutput SUBROUTINE SS_Rad_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -370,12 +365,6 @@ SUBROUTINE SS_Rad_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -392,34 +381,20 @@ SUBROUTINE SS_Rad_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Xferred = 1 i1_l = LBOUND(OutData%WriteOutputHdr,1) i1_u = UBOUND(OutData%WriteOutputHdr,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. 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 !i1 - DEALLOCATE(mask1) + 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 i1_l = LBOUND(OutData%WriteOutputUnt,1) i1_u = UBOUND(OutData%WriteOutputUnt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. 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 !i1 - DEALLOCATE(mask1) + 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 SUBROUTINE SS_Rad_UnPackInitOutput SUBROUTINE SS_Rad_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) @@ -503,7 +478,7 @@ SUBROUTINE SS_Rad_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Int_BufSz = Int_BufSz + 1 ! x allocated yes/no IF ( ALLOCATED(InData%x) ) THEN Int_BufSz = Int_BufSz + 2*1 ! x upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%x) ! x + Db_BufSz = Db_BufSz + SIZE(InData%x) ! x END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) @@ -542,8 +517,10 @@ SUBROUTINE SS_Rad_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%x)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%x))-1 ) = PACK(InData%x,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%x) + DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) + DbKiBuf(Db_Xferred) = InData%x(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF END SUBROUTINE SS_Rad_PackContState @@ -560,12 +537,6 @@ SUBROUTINE SS_Rad_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -593,15 +564,10 @@ SUBROUTINE SS_Rad_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%x)>0) OutData%x = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%x))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%x) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) + OutData%x(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO END IF END SUBROUTINE SS_Rad_UnPackContState @@ -696,8 +662,8 @@ SUBROUTINE SS_Rad_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyDiscState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyDiscState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE SS_Rad_PackDiscState SUBROUTINE SS_Rad_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -713,12 +679,6 @@ SUBROUTINE SS_Rad_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_UnPackDiscState' @@ -732,8 +692,8 @@ SUBROUTINE SS_Rad_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyDiscState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyDiscState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE SS_Rad_UnPackDiscState SUBROUTINE SS_Rad_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) @@ -827,8 +787,8 @@ SUBROUTINE SS_Rad_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyConstrState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE SS_Rad_PackConstrState SUBROUTINE SS_Rad_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -844,12 +804,6 @@ SUBROUTINE SS_Rad_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_UnPackConstrState' @@ -863,8 +817,8 @@ SUBROUTINE SS_Rad_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyConstrState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyConstrState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE SS_Rad_UnPackConstrState SUBROUTINE SS_Rad_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -987,8 +941,8 @@ SUBROUTINE SS_Rad_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%n - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%n + Int_Xferred = Int_Xferred + 1 DO i1 = LBOUND(InData%xdot,1), UBOUND(InData%xdot,1) CALL SS_Rad_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%xdot(i1), ErrStat2, ErrMsg2, OnlySize ) ! xdot CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -1034,12 +988,6 @@ SUBROUTINE SS_Rad_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1054,8 +1002,8 @@ SUBROUTINE SS_Rad_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%n = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%n = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%xdot,1) i1_u = UBOUND(OutData%xdot,1) DO i1 = LBOUND(OutData%xdot,1), UBOUND(OutData%xdot,1) @@ -1193,8 +1141,8 @@ SUBROUTINE SS_Rad_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyMiscVar - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyMiscVar + Re_Xferred = Re_Xferred + 1 END SUBROUTINE SS_Rad_PackMisc SUBROUTINE SS_Rad_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1210,12 +1158,6 @@ SUBROUTINE SS_Rad_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_UnPackMisc' @@ -1229,8 +1171,8 @@ SUBROUTINE SS_Rad_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyMiscVar = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyMiscVar = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE SS_Rad_UnPackMisc SUBROUTINE SS_Rad_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -1396,8 +1338,8 @@ SUBROUTINE SS_Rad_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 IF ( .NOT. ALLOCATED(InData%A) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1411,8 +1353,12 @@ SUBROUTINE SS_Rad_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%A,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%A)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%A))-1 ) = PACK(InData%A,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%A) + DO i2 = LBOUND(InData%A,2), UBOUND(InData%A,2) + DO i1 = LBOUND(InData%A,1), UBOUND(InData%A,1) + ReKiBuf(Re_Xferred) = InData%A(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%B) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1427,8 +1373,12 @@ SUBROUTINE SS_Rad_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%B,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%B)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%B))-1 ) = PACK(InData%B,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%B) + DO i2 = LBOUND(InData%B,2), UBOUND(InData%B,2) + DO i1 = LBOUND(InData%B,1), UBOUND(InData%B,1) + ReKiBuf(Re_Xferred) = InData%B(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%C) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1443,13 +1393,19 @@ SUBROUTINE SS_Rad_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%C)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%C))-1 ) = PACK(InData%C,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%C) + DO i2 = LBOUND(InData%C,2), UBOUND(InData%C,2) + DO i1 = LBOUND(InData%C,1), UBOUND(InData%C,1) + ReKiBuf(Re_Xferred) = InData%C(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%N - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%spdof))-1 ) = PACK(InData%spdof,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%spdof) + IntKiBuf(Int_Xferred) = InData%N + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%spdof,1), UBOUND(InData%spdof,1) + IntKiBuf(Int_Xferred) = InData%spdof(i1) + Int_Xferred = Int_Xferred + 1 + END DO END SUBROUTINE SS_Rad_PackParam SUBROUTINE SS_Rad_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1465,12 +1421,6 @@ SUBROUTINE SS_Rad_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -1486,8 +1436,8 @@ SUBROUTINE SS_Rad_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! A not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1504,15 +1454,12 @@ SUBROUTINE SS_Rad_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%A.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%A)>0) OutData%A = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%A))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%A) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%A,2), UBOUND(OutData%A,2) + DO i1 = LBOUND(OutData%A,1), UBOUND(OutData%A,1) + OutData%A(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! B not allocated Int_Xferred = Int_Xferred + 1 @@ -1530,15 +1477,12 @@ SUBROUTINE SS_Rad_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%B.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%B)>0) OutData%B = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%B))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%B) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%B,2), UBOUND(OutData%B,2) + DO i1 = LBOUND(OutData%B,1), UBOUND(OutData%B,1) + OutData%B(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C not allocated Int_Xferred = Int_Xferred + 1 @@ -1556,29 +1500,21 @@ SUBROUTINE SS_Rad_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%C)>0) OutData%C = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%C))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%C) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%C,2), UBOUND(OutData%C,2) + DO i1 = LBOUND(OutData%C,1), UBOUND(OutData%C,1) + OutData%C(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - OutData%N = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%N = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%spdof,1) i1_u = UBOUND(OutData%spdof,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%spdof = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%spdof))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%spdof) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%spdof,1), UBOUND(OutData%spdof,1) + OutData%spdof(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END SUBROUTINE SS_Rad_UnPackParam SUBROUTINE SS_Rad_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -1673,8 +1609,10 @@ SUBROUTINE SS_Rad_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%dq))-1 ) = PACK(InData%dq,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%dq) + DO i1 = LBOUND(InData%dq,1), UBOUND(InData%dq,1) + ReKiBuf(Re_Xferred) = InData%dq(i1) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE SS_Rad_PackInput SUBROUTINE SS_Rad_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1690,12 +1628,6 @@ SUBROUTINE SS_Rad_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1712,15 +1644,10 @@ SUBROUTINE SS_Rad_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Int_Xferred = 1 i1_l = LBOUND(OutData%dq,1) i1_u = UBOUND(OutData%dq,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%dq = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%dq))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%dq) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%dq,1), UBOUND(OutData%dq,1) + OutData%dq(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE SS_Rad_UnPackInput SUBROUTINE SS_Rad_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -1817,10 +1744,14 @@ SUBROUTINE SS_Rad_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%y))-1 ) = PACK(InData%y,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%y) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WriteOutput))-1 ) = PACK(InData%WriteOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WriteOutput) + DO i1 = LBOUND(InData%y,1), UBOUND(InData%y,1) + ReKiBuf(Re_Xferred) = InData%y(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE SS_Rad_PackOutput SUBROUTINE SS_Rad_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1836,12 +1767,6 @@ SUBROUTINE SS_Rad_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1858,26 +1783,16 @@ SUBROUTINE SS_Rad_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Int_Xferred = 1 i1_l = LBOUND(OutData%y,1) i1_u = UBOUND(OutData%y,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%y = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%y))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%y) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%y,1), UBOUND(OutData%y,1) + OutData%y(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%WriteOutput,1) i1_u = UBOUND(OutData%WriteOutput,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%WriteOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WriteOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WriteOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE SS_Rad_UnPackOutput @@ -1955,12 +1870,12 @@ SUBROUTINE SS_Rad_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrM REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -1973,12 +1888,12 @@ SUBROUTINE SS_Rad_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(b1(SIZE(u_out%dq,1))) - ALLOCATE(c1(SIZE(u_out%dq,1))) - b1 = -(u1%dq - u2%dq)/t(2) - u_out%dq = u1%dq + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + + ScaleFactor = t_out / t(2) + DO i1 = LBOUND(u_out%dq,1),UBOUND(u_out%dq,1) + b = -(u1%dq(i1) - u2%dq(i1)) + u_out%dq(i1) = u1%dq(i1) + b * ScaleFactor + END DO END SUBROUTINE SS_Rad_Input_ExtrapInterp1 @@ -2008,13 +1923,14 @@ SUBROUTINE SS_Rad_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -2033,13 +1949,13 @@ SUBROUTINE SS_Rad_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(b1(SIZE(u_out%dq,1))) - ALLOCATE(c1(SIZE(u_out%dq,1))) - b1 = (t(3)**2*(u1%dq - u2%dq) + t(2)**2*(-u1%dq + u3%dq))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%dq + t(3)*u2%dq - t(2)*u3%dq ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%dq = u1%dq + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) + DO i1 = LBOUND(u_out%dq,1),UBOUND(u_out%dq,1) + b = (t(3)**2*(u1%dq(i1) - u2%dq(i1)) + t(2)**2*(-u1%dq(i1) + u3%dq(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%dq(i1) + t(3)*u2%dq(i1) - t(2)*u3%dq(i1) ) * scaleFactor + u_out%dq(i1) = u1%dq(i1) + b + c * t_out + END DO END SUBROUTINE SS_Rad_Input_ExtrapInterp2 @@ -2117,12 +2033,12 @@ SUBROUTINE SS_Rad_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, Err REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -2135,18 +2051,16 @@ SUBROUTINE SS_Rad_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(b1(SIZE(y_out%y,1))) - ALLOCATE(c1(SIZE(y_out%y,1))) - b1 = -(y1%y - y2%y)/t(2) - y_out%y = y1%y + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = -(y1%WriteOutput - y2%WriteOutput)/t(2) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + + ScaleFactor = t_out / t(2) + DO i1 = LBOUND(y_out%y,1),UBOUND(y_out%y,1) + b = -(y1%y(i1) - y2%y(i1)) + y_out%y(i1) = y1%y(i1) + b * ScaleFactor + END DO + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO END SUBROUTINE SS_Rad_Output_ExtrapInterp1 @@ -2176,13 +2090,14 @@ SUBROUTINE SS_Rad_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'SS_Rad_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -2201,20 +2116,18 @@ SUBROUTINE SS_Rad_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(b1(SIZE(y_out%y,1))) - ALLOCATE(c1(SIZE(y_out%y,1))) - b1 = (t(3)**2*(y1%y - y2%y) + t(2)**2*(-y1%y + y3%y))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%y + t(3)*y2%y - t(2)*y3%y ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%y = y1%y + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = (t(3)**2*(y1%WriteOutput - y2%WriteOutput) + t(2)**2*(-y1%WriteOutput + y3%WriteOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WriteOutput + t(3)*y2%WriteOutput - t(2)*y3%WriteOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) + DO i1 = LBOUND(y_out%y,1),UBOUND(y_out%y,1) + b = (t(3)**2*(y1%y(i1) - y2%y(i1)) + t(2)**2*(-y1%y(i1) + y3%y(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%y(i1) + t(3)*y2%y(i1) - t(2)*y3%y(i1) ) * scaleFactor + y_out%y(i1) = y1%y(i1) + b + c * t_out + END DO + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO END SUBROUTINE SS_Rad_Output_ExtrapInterp2 END MODULE SS_Radiation_Types diff --git a/modules/hydrodyn/src/WAMIT.txt b/modules/hydrodyn/src/WAMIT.txt index bf5c92d65a..b4aedf027e 100644 --- a/modules/hydrodyn/src/WAMIT.txt +++ b/modules/hydrodyn/src/WAMIT.txt @@ -35,7 +35,7 @@ typedef ^ ^ ReKi typedef ^ ^ INTEGER NStepWave - - - "" - typedef ^ ^ INTEGER NStepWave2 - - - "" - typedef ^ ^ ReKi WaveDOmega - - - "" - -typedef ^ ^ SiKi WaveElev0 {:} - - "Wave elevation time history at origin (needed for SS_Excitation module)" m +typedef ^ ^ SiKi WaveElev0 {:} - - "Wave elevation time history at origin (needed for SS_Excitation module)" m typedef ^ ^ SiKi WaveElevC0 {:}{:} - - "Discrete Fourier transform of the instantaneous elevation of incident waves at the platform reference point. First column is real part, second column is imaginary part" (meters) typedef ^ ^ SiKi WaveTime {:} - - "" - typedef ^ ^ INTEGER WaveMod - - - "" - @@ -133,7 +133,7 @@ typedef ^ ^ INTEGER typedef ^ ^ INTEGER NumOutAll - - - "" - typedef ^ ^ CHARACTER(20) OutFmt - - - "" - typedef ^ ^ CHARACTER(20) OutSFmt - - - "" - -typedef ^ ^ CHARACTER(10) Delim - - - "" - +typedef ^ ^ CHARACTER(ChanLen) Delim - - - "" - typedef ^ ^ INTEGER UnOutFile - - - "" - # # diff --git a/modules/hydrodyn/src/WAMIT2.txt b/modules/hydrodyn/src/WAMIT2.txt index 5279528267..4226c37ca4 100644 --- a/modules/hydrodyn/src/WAMIT2.txt +++ b/modules/hydrodyn/src/WAMIT2.txt @@ -126,7 +126,7 @@ typedef ^ ^ INTEGER NumOuts typedef ^ ^ INTEGER NumOutAll - - - "" - typedef ^ ^ CHARACTER(20) OutFmt - - - "" - typedef ^ ^ CHARACTER(20) OutSFmt - - - "" - -typedef ^ ^ CHARACTER(10) Delim - - - "" - +typedef ^ ^ CHARACTER(ChanLen) Delim - - - "" - typedef ^ ^ INTEGER UnOutFile - - - "" - diff --git a/modules/hydrodyn/src/WAMIT2_Types.f90 b/modules/hydrodyn/src/WAMIT2_Types.f90 index 6ad1409a2f..af1cddd8dd 100644 --- a/modules/hydrodyn/src/WAMIT2_Types.f90 +++ b/modules/hydrodyn/src/WAMIT2_Types.f90 @@ -130,7 +130,7 @@ MODULE WAMIT2_Types INTEGER(IntKi) :: NumOutAll !< [-] CHARACTER(20) :: OutFmt !< [-] CHARACTER(20) :: OutSFmt !< [-] - CHARACTER(10) :: Delim !< [-] + CHARACTER(ChanLen) :: Delim !< [-] INTEGER(IntKi) :: UnOutFile !< [-] END TYPE WAMIT2_ParameterType ! ======================= @@ -375,26 +375,26 @@ SUBROUTINE WAMIT2_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%HasWAMIT , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%WAMITFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%WAMITFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UnSum - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WAMITULEN - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RhoXg - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NStepWave2 - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WaveDOmega - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WtrDens - Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%HasWAMIT, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%WAMITFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%WAMITFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%UnSum + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WAMITULEN + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RhoXg + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepWave + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepWave2 + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WaveDOmega + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDens + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WaveElevC0) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -408,13 +408,17 @@ SUBROUTINE WAMIT2_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC0,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElevC0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElevC0))-1 ) = PACK(InData%WaveElevC0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElevC0) + DO i2 = LBOUND(InData%WaveElevC0,2), UBOUND(InData%WaveElevC0,2) + DO i1 = LBOUND(InData%WaveElevC0,1), UBOUND(InData%WaveElevC0,1) + ReKiBuf(Re_Xferred) = InData%WaveElevC0(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WaveDir - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%WaveMultiDir , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WaveDir + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%WaveMultiDir, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WaveDirArr) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -425,13 +429,15 @@ SUBROUTINE WAMIT2_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDirArr,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveDirArr)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveDirArr))-1 ) = PACK(InData%WaveDirArr,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveDirArr) + DO i1 = LBOUND(InData%WaveDirArr,1), UBOUND(InData%WaveDirArr,1) + ReKiBuf(Re_Xferred) = InData%WaveDirArr(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WaveDirMin - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WaveDirMax - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WaveDirMin + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WaveDirMax + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WaveTime) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -442,63 +448,65 @@ SUBROUTINE WAMIT2_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveTime)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveTime))-1 ) = PACK(InData%WaveTime,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveTime) + DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) + ReKiBuf(Re_Xferred) = InData%WaveTime(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) - DO I = 1, LEN(InData%OutList) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%OutAll , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOutAll - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WaveMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmSgF2 , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmSwF2 , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmHvF2 , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmRF2 , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmPF2 , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmYF2 , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MnDrift - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NewmanApp - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DiffQTF - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%SumQTF - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%MnDriftF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%NewmanAppF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%DiffQTFF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%SumQTFF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WvLowCOff - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WvHiCOff - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WvLowCOffD - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WvHiCOffD - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WvLowCOffS - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WvHiCOffS - Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(InData%OutList) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + IntKiBuf(Int_Xferred) = TRANSFER(InData%OutAll, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOutAll + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WaveMod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmSgF2, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmSwF2, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmHvF2, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmRF2, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmPF2, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmYF2, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MnDrift + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NewmanApp + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DiffQTF + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%SumQTF + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%MnDriftF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%NewmanAppF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%DiffQTFF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%SumQTFF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WvLowCOff + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WvHiCOff + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WvLowCOffD + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WvHiCOffD + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WvLowCOffS + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WvHiCOffS + Re_Xferred = Re_Xferred + 1 END SUBROUTINE WAMIT2_PackInitInput SUBROUTINE WAMIT2_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -514,12 +522,6 @@ SUBROUTINE WAMIT2_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -535,26 +537,26 @@ SUBROUTINE WAMIT2_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%HasWAMIT = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%WAMITFile) - OutData%WAMITFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%UnSum = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%WAMITULEN = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RhoXg = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NStepWave = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NStepWave2 = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%WaveDOmega = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%HasWAMIT = TRANSFER(IntKiBuf(Int_Xferred), OutData%HasWAMIT) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%WAMITFile) + OutData%WAMITFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%UnSum = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WAMITULEN = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RhoXg = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NStepWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NStepWave2 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WaveDOmega = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WtrDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevC0 not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -571,20 +573,17 @@ SUBROUTINE WAMIT2_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveElevC0)>0) OutData%WaveElevC0 = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElevC0))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElevC0) - DEALLOCATE(mask2) - END IF - OutData%WaveDir = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveMultiDir = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(OutData%WaveElevC0,2), UBOUND(OutData%WaveElevC0,2) + DO i1 = LBOUND(OutData%WaveElevC0,1), UBOUND(OutData%WaveElevC0,1) + OutData%WaveElevC0(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%WaveDir = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WaveMultiDir = TRANSFER(IntKiBuf(Int_Xferred), OutData%WaveMultiDir) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDirArr not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -598,20 +597,15 @@ SUBROUTINE WAMIT2_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDirArr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveDirArr)>0) OutData%WaveDirArr = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveDirArr))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveDirArr) - DEALLOCATE(mask1) - END IF - OutData%WaveDirMin = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveDirMax = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%WaveDirArr,1), UBOUND(OutData%WaveDirArr,1) + OutData%WaveDirArr(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%WaveDirMin = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WaveDirMax = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -625,79 +619,67 @@ SUBROUTINE WAMIT2_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveTime)>0) OutData%WaveTime = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveTime))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveTime) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) + OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF i1_l = LBOUND(OutData%OutList,1) i1_u = UBOUND(OutData%OutList,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) - DO I = 1, LEN(OutData%OutList) - OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - DEALLOCATE(mask1) - OutData%OutAll = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumOutAll = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%WaveMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmSgF2 = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmSwF2 = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmHvF2 = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmRF2 = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmPF2 = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmYF2 = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%MnDrift = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NewmanApp = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%DiffQTF = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%SumQTF = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%MnDriftF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NewmanAppF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%DiffQTFF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%SumQTFF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%WvLowCOff = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%WvHiCOff = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%WvLowCOffD = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%WvHiCOffD = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%WvLowCOffS = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%WvHiCOffS = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(OutData%OutList) + OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + OutData%OutAll = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutAll) + Int_Xferred = Int_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumOutAll = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WaveMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%PtfmSgF2 = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmSgF2) + Int_Xferred = Int_Xferred + 1 + OutData%PtfmSwF2 = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmSwF2) + Int_Xferred = Int_Xferred + 1 + OutData%PtfmHvF2 = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmHvF2) + Int_Xferred = Int_Xferred + 1 + OutData%PtfmRF2 = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmRF2) + Int_Xferred = Int_Xferred + 1 + OutData%PtfmPF2 = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmPF2) + Int_Xferred = Int_Xferred + 1 + OutData%PtfmYF2 = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmYF2) + Int_Xferred = Int_Xferred + 1 + OutData%MnDrift = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NewmanApp = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%DiffQTF = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%SumQTF = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%MnDriftF = TRANSFER(IntKiBuf(Int_Xferred), OutData%MnDriftF) + Int_Xferred = Int_Xferred + 1 + OutData%NewmanAppF = TRANSFER(IntKiBuf(Int_Xferred), OutData%NewmanAppF) + Int_Xferred = Int_Xferred + 1 + OutData%DiffQTFF = TRANSFER(IntKiBuf(Int_Xferred), OutData%DiffQTFF) + Int_Xferred = Int_Xferred + 1 + OutData%SumQTFF = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumQTFF) + Int_Xferred = Int_Xferred + 1 + OutData%WvLowCOff = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WvHiCOff = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WvLowCOffD = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WvHiCOffD = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WvLowCOffS = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WvHiCOffS = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE WAMIT2_UnPackInitInput SUBROUTINE WAMIT2_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -840,12 +822,12 @@ SUBROUTINE WAMIT2_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -857,12 +839,12 @@ SUBROUTINE WAMIT2_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF END SUBROUTINE WAMIT2_PackInitOutput @@ -879,12 +861,6 @@ SUBROUTINE WAMIT2_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -912,19 +888,12 @@ SUBROUTINE WAMIT2_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated Int_Xferred = Int_Xferred + 1 @@ -939,19 +908,12 @@ SUBROUTINE WAMIT2_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF END SUBROUTINE WAMIT2_UnPackInitOutput @@ -1046,8 +1008,8 @@ SUBROUTINE WAMIT2_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyContState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyContState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE WAMIT2_PackContState SUBROUTINE WAMIT2_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1063,12 +1025,6 @@ SUBROUTINE WAMIT2_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_UnPackContState' @@ -1082,8 +1038,8 @@ SUBROUTINE WAMIT2_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyContState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyContState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE WAMIT2_UnPackContState SUBROUTINE WAMIT2_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) @@ -1177,8 +1133,8 @@ SUBROUTINE WAMIT2_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyDiscState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyDiscState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE WAMIT2_PackDiscState SUBROUTINE WAMIT2_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1194,12 +1150,6 @@ SUBROUTINE WAMIT2_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_UnPackDiscState' @@ -1213,8 +1163,8 @@ SUBROUTINE WAMIT2_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyDiscState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyDiscState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE WAMIT2_UnPackDiscState SUBROUTINE WAMIT2_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) @@ -1308,8 +1258,8 @@ SUBROUTINE WAMIT2_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyConstrState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE WAMIT2_PackConstrState SUBROUTINE WAMIT2_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1325,12 +1275,6 @@ SUBROUTINE WAMIT2_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_UnPackConstrState' @@ -1344,8 +1288,8 @@ SUBROUTINE WAMIT2_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyConstrState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyConstrState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE WAMIT2_UnPackConstrState SUBROUTINE WAMIT2_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -1439,8 +1383,8 @@ SUBROUTINE WAMIT2_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DummyOtherState - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DummyOtherState + Int_Xferred = Int_Xferred + 1 END SUBROUTINE WAMIT2_PackOtherState SUBROUTINE WAMIT2_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1456,12 +1400,6 @@ SUBROUTINE WAMIT2_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_UnPackOtherState' @@ -1475,8 +1413,8 @@ SUBROUTINE WAMIT2_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyOtherState = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%DummyOtherState = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE WAMIT2_UnPackOtherState SUBROUTINE WAMIT2_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) @@ -1573,10 +1511,12 @@ SUBROUTINE WAMIT2_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%LastIndWave - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F_Waves2))-1 ) = PACK(InData%F_Waves2,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F_Waves2) + IntKiBuf(Int_Xferred) = InData%LastIndWave + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%F_Waves2,1), UBOUND(InData%F_Waves2,1) + ReKiBuf(Re_Xferred) = InData%F_Waves2(i1) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE WAMIT2_PackMisc SUBROUTINE WAMIT2_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1592,12 +1532,6 @@ SUBROUTINE WAMIT2_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1612,19 +1546,14 @@ SUBROUTINE WAMIT2_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%LastIndWave = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%LastIndWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%F_Waves2,1) i1_u = UBOUND(OutData%F_Waves2,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%F_Waves2 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F_Waves2))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F_Waves2) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%F_Waves2,1), UBOUND(OutData%F_Waves2,1) + OutData%F_Waves2(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE WAMIT2_UnPackMisc SUBROUTINE WAMIT2_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -1848,13 +1777,15 @@ SUBROUTINE WAMIT2_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveTime)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveTime))-1 ) = PACK(InData%WaveTime,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveTime) + DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) + ReKiBuf(Re_Xferred) = InData%WaveTime(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepWave + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WaveExctn2) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1868,25 +1799,37 @@ SUBROUTINE WAMIT2_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveExctn2,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveExctn2)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveExctn2))-1 ) = PACK(InData%WaveExctn2,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveExctn2) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%MnDriftDims)-1 ) = TRANSFER(PACK( InData%MnDriftDims ,.TRUE.), IntKiBuf(1), SIZE(InData%MnDriftDims)) - Int_Xferred = Int_Xferred + SIZE(InData%MnDriftDims) - IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%NewmanAppDims)-1 ) = TRANSFER(PACK( InData%NewmanAppDims ,.TRUE.), IntKiBuf(1), SIZE(InData%NewmanAppDims)) - Int_Xferred = Int_Xferred + SIZE(InData%NewmanAppDims) - IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%DiffQTFDims)-1 ) = TRANSFER(PACK( InData%DiffQTFDims ,.TRUE.), IntKiBuf(1), SIZE(InData%DiffQTFDims)) - Int_Xferred = Int_Xferred + SIZE(InData%DiffQTFDims) - IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%SumQTFDims)-1 ) = TRANSFER(PACK( InData%SumQTFDims ,.TRUE.), IntKiBuf(1), SIZE(InData%SumQTFDims)) - Int_Xferred = Int_Xferred + SIZE(InData%SumQTFDims) - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%MnDriftF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%NewmanAppF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%DiffQTFF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%SumQTFF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(InData%WaveExctn2,2), UBOUND(InData%WaveExctn2,2) + DO i1 = LBOUND(InData%WaveExctn2,1), UBOUND(InData%WaveExctn2,1) + ReKiBuf(Re_Xferred) = InData%WaveExctn2(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + DO i1 = LBOUND(InData%MnDriftDims,1), UBOUND(InData%MnDriftDims,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%MnDriftDims(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + DO i1 = LBOUND(InData%NewmanAppDims,1), UBOUND(InData%NewmanAppDims,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%NewmanAppDims(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + DO i1 = LBOUND(InData%DiffQTFDims,1), UBOUND(InData%DiffQTFDims,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%DiffQTFDims(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + DO i1 = LBOUND(InData%SumQTFDims,1), UBOUND(InData%SumQTFDims,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%SumQTFDims(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = TRANSFER(InData%MnDriftF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%NewmanAppF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%DiffQTFF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%SumQTFF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%OutParam) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1928,24 +1871,24 @@ SUBROUTINE WAMIT2_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg ENDIF END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOutAll - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%OutSFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutSFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%Delim) - IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UnOutFile - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOutAll + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%OutFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%OutSFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutSFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%Delim) + IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%UnOutFile + Int_Xferred = Int_Xferred + 1 END SUBROUTINE WAMIT2_PackParam SUBROUTINE WAMIT2_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1961,12 +1904,6 @@ SUBROUTINE WAMIT2_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -1995,20 +1932,15 @@ SUBROUTINE WAMIT2_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveTime)>0) OutData%WaveTime = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveTime))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveTime) - DEALLOCATE(mask1) - END IF - OutData%NStepWave = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) + OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%NStepWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveExctn2 not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -2025,68 +1957,45 @@ SUBROUTINE WAMIT2_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveExctn2.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveExctn2)>0) OutData%WaveExctn2 = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveExctn2))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveExctn2) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveExctn2,2), UBOUND(OutData%WaveExctn2,2) + DO i1 = LBOUND(OutData%WaveExctn2,1), UBOUND(OutData%WaveExctn2,1) + OutData%WaveExctn2(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF i1_l = LBOUND(OutData%MnDriftDims,1) i1_u = UBOUND(OutData%MnDriftDims,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%MnDriftDims = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%MnDriftDims))-1 ), OutData%MnDriftDims), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%MnDriftDims) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%MnDriftDims,1), UBOUND(OutData%MnDriftDims,1) + OutData%MnDriftDims(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%MnDriftDims(i1)) + Int_Xferred = Int_Xferred + 1 + END DO i1_l = LBOUND(OutData%NewmanAppDims,1) i1_u = UBOUND(OutData%NewmanAppDims,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%NewmanAppDims = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%NewmanAppDims))-1 ), OutData%NewmanAppDims), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%NewmanAppDims) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%NewmanAppDims,1), UBOUND(OutData%NewmanAppDims,1) + OutData%NewmanAppDims(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%NewmanAppDims(i1)) + Int_Xferred = Int_Xferred + 1 + END DO i1_l = LBOUND(OutData%DiffQTFDims,1) i1_u = UBOUND(OutData%DiffQTFDims,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%DiffQTFDims = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%DiffQTFDims))-1 ), OutData%DiffQTFDims), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%DiffQTFDims) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%DiffQTFDims,1), UBOUND(OutData%DiffQTFDims,1) + OutData%DiffQTFDims(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%DiffQTFDims(i1)) + Int_Xferred = Int_Xferred + 1 + END DO i1_l = LBOUND(OutData%SumQTFDims,1) i1_u = UBOUND(OutData%SumQTFDims,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%SumQTFDims = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%SumQTFDims))-1 ), OutData%SumQTFDims), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%SumQTFDims) - DEALLOCATE(mask1) - OutData%MnDriftF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NewmanAppF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%DiffQTFF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%SumQTFF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%SumQTFDims,1), UBOUND(OutData%SumQTFDims,1) + OutData%SumQTFDims(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumQTFDims(i1)) + Int_Xferred = Int_Xferred + 1 + END DO + OutData%MnDriftF = TRANSFER(IntKiBuf(Int_Xferred), OutData%MnDriftF) + Int_Xferred = Int_Xferred + 1 + OutData%NewmanAppF = TRANSFER(IntKiBuf(Int_Xferred), OutData%NewmanAppF) + Int_Xferred = Int_Xferred + 1 + OutData%DiffQTFF = TRANSFER(IntKiBuf(Int_Xferred), OutData%DiffQTFF) + Int_Xferred = Int_Xferred + 1 + OutData%SumQTFF = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumQTFF) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParam not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -2143,24 +2052,24 @@ SUBROUTINE WAMIT2_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumOutAll = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutFmt) - OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%OutSFmt) - OutData%OutSFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Delim) - OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%UnOutFile = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumOutAll = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%OutFmt) + OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%OutSFmt) + OutData%OutSFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%Delim) + OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%UnOutFile = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE WAMIT2_UnPackParam SUBROUTINE WAMIT2_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -2317,12 +2226,6 @@ SUBROUTINE WAMIT2_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_UnPackInput' @@ -2548,8 +2451,10 @@ SUBROUTINE WAMIT2_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WriteOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WriteOutput))-1 ) = PACK(InData%WriteOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WriteOutput) + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE WAMIT2_PackOutput @@ -2566,12 +2471,6 @@ SUBROUTINE WAMIT2_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -2639,15 +2538,10 @@ SUBROUTINE WAMIT2_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WriteOutput)>0) OutData%WriteOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WriteOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WriteOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE WAMIT2_UnPackOutput @@ -2726,8 +2620,8 @@ SUBROUTINE WAMIT2_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrM REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -2742,6 +2636,8 @@ SUBROUTINE WAMIT2_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(u1%Mesh, u2%Mesh, tin, u_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE WAMIT2_Input_ExtrapInterp1 @@ -2773,8 +2669,9 @@ SUBROUTINE WAMIT2_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_Input_ExtrapInterp2' @@ -2796,6 +2693,8 @@ SUBROUTINE WAMIT2_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(u1%Mesh, u2%Mesh, u3%Mesh, tin, u_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE WAMIT2_Input_ExtrapInterp2 @@ -2875,12 +2774,12 @@ SUBROUTINE WAMIT2_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, Err REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -2893,15 +2792,15 @@ SUBROUTINE WAMIT2_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(y1%Mesh, y2%Mesh, tin, y_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = -(y1%WriteOutput - y2%WriteOutput)/t(2) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO END IF ! check if allocated END SUBROUTINE WAMIT2_Output_ExtrapInterp1 @@ -2932,13 +2831,14 @@ SUBROUTINE WAMIT2_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT2_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -2957,16 +2857,16 @@ SUBROUTINE WAMIT2_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(y1%Mesh, y2%Mesh, y3%Mesh, tin, y_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = (t(3)**2*(y1%WriteOutput - y2%WriteOutput) + t(2)**2*(-y1%WriteOutput + y3%WriteOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WriteOutput + t(3)*y2%WriteOutput - t(2)*y3%WriteOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO END IF ! check if allocated END SUBROUTINE WAMIT2_Output_ExtrapInterp2 diff --git a/modules/hydrodyn/src/WAMIT_Types.f90 b/modules/hydrodyn/src/WAMIT_Types.f90 index 48f084d1f4..b321d69848 100644 --- a/modules/hydrodyn/src/WAMIT_Types.f90 +++ b/modules/hydrodyn/src/WAMIT_Types.f90 @@ -149,7 +149,7 @@ MODULE WAMIT_Types INTEGER(IntKi) :: NumOutAll !< [-] CHARACTER(20) :: OutFmt !< [-] CHARACTER(20) :: OutSFmt !< [-] - CHARACTER(10) :: Delim !< [-] + CHARACTER(ChanLen) :: Delim !< [-] INTEGER(IntKi) :: UnOutFile !< [-] END TYPE WAMIT_ParameterType ! ======================= @@ -402,28 +402,28 @@ SUBROUTINE WAMIT_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmVol0 - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%HasWAMIT , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WAMITULEN - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmCOBxt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmCOByt - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%RdtnMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%ExctnMod - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%RdtnTMax - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WaveDir - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%WAMITFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%WAMITFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + ReKiBuf(Re_Xferred) = InData%PtfmVol0 + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%HasWAMIT, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WAMITULEN + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmCOBxt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmCOByt + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%RdtnMod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%ExctnMod + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%RdtnTMax + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WaveDir + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(InData%WAMITFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%WAMITFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I CALL Conv_Rdtn_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%Conv_Rdtn, ErrStat2, ErrMsg2, OnlySize ) ! Conv_Rdtn CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -452,14 +452,14 @@ SUBROUTINE WAMIT_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Rhoxg - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NStepWave2 - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WaveDOmega - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Rhoxg + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepWave + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepWave2 + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WaveDOmega + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WaveElev0) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -470,8 +470,10 @@ SUBROUTINE WAMIT_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev0,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElev0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElev0))-1 ) = PACK(InData%WaveElev0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElev0) + DO i1 = LBOUND(InData%WaveElev0,1), UBOUND(InData%WaveElev0,1) + ReKiBuf(Re_Xferred) = InData%WaveElev0(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveElevC0) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -486,8 +488,12 @@ SUBROUTINE WAMIT_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC0,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElevC0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElevC0))-1 ) = PACK(InData%WaveElevC0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElevC0) + DO i2 = LBOUND(InData%WaveElevC0,2), UBOUND(InData%WaveElevC0,2) + DO i1 = LBOUND(InData%WaveElevC0,1), UBOUND(InData%WaveElevC0,1) + ReKiBuf(Re_Xferred) = InData%WaveElevC0(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveTime) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -499,13 +505,15 @@ SUBROUTINE WAMIT_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveTime)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveTime))-1 ) = PACK(InData%WaveTime,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveTime) + DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) + ReKiBuf(Re_Xferred) = InData%WaveTime(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WaveMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WtrDens - Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WaveMod + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDens + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WaveDirArr) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -516,23 +524,25 @@ SUBROUTINE WAMIT_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDirArr,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveDirArr)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveDirArr))-1 ) = PACK(InData%WaveDirArr,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveDirArr) + DO i1 = LBOUND(InData%WaveDirArr,1), UBOUND(InData%WaveDirArr,1) + ReKiBuf(Re_Xferred) = InData%WaveDirArr(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WaveDirMin - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WaveDirMax - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WaveDirMin + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WaveDirMax + Re_Xferred = Re_Xferred + 1 DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) - DO I = 1, LEN(InData%OutList) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%OutAll , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%OutList) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + IntKiBuf(Int_Xferred) = TRANSFER(InData%OutAll, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 END SUBROUTINE WAMIT_PackInitInput SUBROUTINE WAMIT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -548,12 +558,6 @@ SUBROUTINE WAMIT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -569,28 +573,28 @@ SUBROUTINE WAMIT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%PtfmVol0 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HasWAMIT = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%WAMITULEN = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmCOBxt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmCOByt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RdtnMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%ExctnMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%RdtnTMax = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%WaveDir = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%WAMITFile) - OutData%WAMITFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + OutData%PtfmVol0 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HasWAMIT = TRANSFER(IntKiBuf(Int_Xferred), OutData%HasWAMIT) + Int_Xferred = Int_Xferred + 1 + OutData%WAMITULEN = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmCOBxt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmCOByt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RdtnMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ExctnMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%RdtnTMax = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%WaveDir = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(OutData%WAMITFile) + OutData%WAMITFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -631,14 +635,14 @@ SUBROUTINE WAMIT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%Rhoxg = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NStepWave = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NStepWave2 = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%WaveDOmega = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%Rhoxg = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NStepWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NStepWave2 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WaveDOmega = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev0 not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -652,15 +656,10 @@ SUBROUTINE WAMIT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveElev0)>0) OutData%WaveElev0 = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElev0))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElev0) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveElev0,1), UBOUND(OutData%WaveElev0,1) + OutData%WaveElev0(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevC0 not allocated Int_Xferred = Int_Xferred + 1 @@ -678,15 +677,12 @@ SUBROUTINE WAMIT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveElevC0)>0) OutData%WaveElevC0 = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElevC0))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElevC0) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveElevC0,2), UBOUND(OutData%WaveElevC0,2) + DO i1 = LBOUND(OutData%WaveElevC0,1), UBOUND(OutData%WaveElevC0,1) + OutData%WaveElevC0(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated Int_Xferred = Int_Xferred + 1 @@ -701,20 +697,15 @@ SUBROUTINE WAMIT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveTime)>0) OutData%WaveTime = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveTime))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveTime) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) + OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%WaveMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%WtrDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%WaveMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WtrDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDirArr not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -728,39 +719,27 @@ SUBROUTINE WAMIT_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDirArr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveDirArr)>0) OutData%WaveDirArr = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveDirArr))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveDirArr) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveDirArr,1), UBOUND(OutData%WaveDirArr,1) + OutData%WaveDirArr(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%WaveDirMin = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveDirMax = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%WaveDirMin = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WaveDirMax = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%OutList,1) i1_u = UBOUND(OutData%OutList,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) - DO I = 1, LEN(OutData%OutList) - OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - DEALLOCATE(mask1) - OutData%OutAll = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%OutList) + OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + OutData%OutAll = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutAll) + Int_Xferred = Int_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE WAMIT_UnPackInitInput SUBROUTINE WAMIT_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -903,12 +882,12 @@ SUBROUTINE WAMIT_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -920,12 +899,12 @@ SUBROUTINE WAMIT_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF END SUBROUTINE WAMIT_PackInitOutput @@ -942,12 +921,6 @@ SUBROUTINE WAMIT_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -975,19 +948,12 @@ SUBROUTINE WAMIT_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated Int_Xferred = Int_Xferred + 1 @@ -1002,19 +968,12 @@ SUBROUTINE WAMIT_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF END SUBROUTINE WAMIT_UnPackInitOutput @@ -1270,12 +1229,6 @@ SUBROUTINE WAMIT_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_UnPackContState' @@ -1663,12 +1616,6 @@ SUBROUTINE WAMIT_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_UnPackDiscState' @@ -2056,12 +2003,6 @@ SUBROUTINE WAMIT_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_UnPackConstrState' @@ -2449,12 +2390,6 @@ SUBROUTINE WAMIT_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_UnPackOtherState' @@ -2882,18 +2817,28 @@ SUBROUTINE WAMIT_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%LastIndWave - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F_HS))-1 ) = PACK(InData%F_HS,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F_HS) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F_Waves1))-1 ) = PACK(InData%F_Waves1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F_Waves1) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F_Rdtn))-1 ) = PACK(InData%F_Rdtn,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F_Rdtn) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F_PtfmAdd))-1 ) = PACK(InData%F_PtfmAdd,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F_PtfmAdd) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F_PtfmAM))-1 ) = PACK(InData%F_PtfmAM,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F_PtfmAM) + IntKiBuf(Int_Xferred) = InData%LastIndWave + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%F_HS,1), UBOUND(InData%F_HS,1) + ReKiBuf(Re_Xferred) = InData%F_HS(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%F_Waves1,1), UBOUND(InData%F_Waves1,1) + ReKiBuf(Re_Xferred) = InData%F_Waves1(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%F_Rdtn,1), UBOUND(InData%F_Rdtn,1) + ReKiBuf(Re_Xferred) = InData%F_Rdtn(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%F_PtfmAdd,1), UBOUND(InData%F_PtfmAdd,1) + ReKiBuf(Re_Xferred) = InData%F_PtfmAdd(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%F_PtfmAM,1), UBOUND(InData%F_PtfmAM,1) + ReKiBuf(Re_Xferred) = InData%F_PtfmAM(i1) + Re_Xferred = Re_Xferred + 1 + END DO CALL SS_Rad_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%SS_Rdtn, ErrStat2, ErrMsg2, OnlySize ) ! SS_Rdtn CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3161,12 +3106,6 @@ SUBROUTINE WAMIT_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -3181,63 +3120,38 @@ SUBROUTINE WAMIT_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%LastIndWave = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%LastIndWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%F_HS,1) i1_u = UBOUND(OutData%F_HS,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%F_HS = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F_HS))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F_HS) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%F_HS,1), UBOUND(OutData%F_HS,1) + OutData%F_HS(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%F_Waves1,1) i1_u = UBOUND(OutData%F_Waves1,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%F_Waves1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F_Waves1))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F_Waves1) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%F_Waves1,1), UBOUND(OutData%F_Waves1,1) + OutData%F_Waves1(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%F_Rdtn,1) i1_u = UBOUND(OutData%F_Rdtn,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%F_Rdtn = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F_Rdtn))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F_Rdtn) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%F_Rdtn,1), UBOUND(OutData%F_Rdtn,1) + OutData%F_Rdtn(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%F_PtfmAdd,1) i1_u = UBOUND(OutData%F_PtfmAdd,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%F_PtfmAdd = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F_PtfmAdd))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F_PtfmAdd) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%F_PtfmAdd,1), UBOUND(OutData%F_PtfmAdd,1) + OutData%F_PtfmAdd(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%F_PtfmAM,1) i1_u = UBOUND(OutData%F_PtfmAM,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%F_PtfmAM = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F_PtfmAM))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F_PtfmAM) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%F_PtfmAM,1), UBOUND(OutData%F_PtfmAM,1) + OutData%F_PtfmAM(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -3886,20 +3800,28 @@ SUBROUTINE WAMIT_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%HdroAdMsI))-1 ) = PACK(InData%HdroAdMsI,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%HdroAdMsI) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%HdroSttc))-1 ) = PACK(InData%HdroSttc,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%HdroSttc) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmVol0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmCOBxt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtfmCOByt - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%RdtnMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%ExctnMod - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(InData%HdroAdMsI,2), UBOUND(InData%HdroAdMsI,2) + DO i1 = LBOUND(InData%HdroAdMsI,1), UBOUND(InData%HdroAdMsI,1) + ReKiBuf(Re_Xferred) = InData%HdroAdMsI(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%HdroSttc,2), UBOUND(InData%HdroSttc,2) + DO i1 = LBOUND(InData%HdroSttc,1), UBOUND(InData%HdroSttc,1) + ReKiBuf(Re_Xferred) = InData%HdroSttc(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + ReKiBuf(Re_Xferred) = InData%PtfmVol0 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmCOBxt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtfmCOByt + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%RdtnMod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%ExctnMod + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WaveExctn) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -3913,11 +3835,15 @@ SUBROUTINE WAMIT_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveExctn,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveExctn)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveExctn))-1 ) = PACK(InData%WaveExctn,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveExctn) + DO i2 = LBOUND(InData%WaveExctn,2), UBOUND(InData%WaveExctn,2) + DO i1 = LBOUND(InData%WaveExctn,1), UBOUND(InData%WaveExctn,1) + ReKiBuf(Re_Xferred) = InData%WaveExctn(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RhoXg - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RhoXg + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WaveTime) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -3928,11 +3854,13 @@ SUBROUTINE WAMIT_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveTime)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveTime))-1 ) = PACK(InData%WaveTime,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveTime) + DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) + ReKiBuf(Re_Xferred) = InData%WaveTime(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepWave + Int_Xferred = Int_Xferred + 1 CALL Conv_Rdtn_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%Conv_Rdtn, ErrStat2, ErrMsg2, OnlySize ) ! Conv_Rdtn CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4017,20 +3945,20 @@ SUBROUTINE WAMIT_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmSgF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmSwF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmHvF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmRF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmPF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%PtfmYF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmSgF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmSwF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmHvF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmRF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmPF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%PtfmYF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%OutParam) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4072,24 +4000,24 @@ SUBROUTINE WAMIT_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, ENDIF END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOutAll - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%OutSFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutSFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%Delim) - IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UnOutFile - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOutAll + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%OutFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%OutSFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutSFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%Delim) + IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%UnOutFile + Int_Xferred = Int_Xferred + 1 END SUBROUTINE WAMIT_PackParam SUBROUTINE WAMIT_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -4105,12 +4033,6 @@ SUBROUTINE WAMIT_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -4130,38 +4052,32 @@ SUBROUTINE WAMIT_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM i1_u = UBOUND(OutData%HdroAdMsI,1) i2_l = LBOUND(OutData%HdroAdMsI,2) i2_u = UBOUND(OutData%HdroAdMsI,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%HdroAdMsI = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%HdroAdMsI))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%HdroAdMsI) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%HdroAdMsI,2), UBOUND(OutData%HdroAdMsI,2) + DO i1 = LBOUND(OutData%HdroAdMsI,1), UBOUND(OutData%HdroAdMsI,1) + OutData%HdroAdMsI(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%HdroSttc,1) i1_u = UBOUND(OutData%HdroSttc,1) i2_l = LBOUND(OutData%HdroSttc,2) i2_u = UBOUND(OutData%HdroSttc,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%HdroSttc = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%HdroSttc))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%HdroSttc) - DEALLOCATE(mask2) - OutData%PtfmVol0 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmCOBxt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtfmCOByt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RdtnMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%ExctnMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(OutData%HdroSttc,2), UBOUND(OutData%HdroSttc,2) + DO i1 = LBOUND(OutData%HdroSttc,1), UBOUND(OutData%HdroSttc,1) + OutData%HdroSttc(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + OutData%PtfmVol0 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmCOBxt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtfmCOByt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RdtnMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ExctnMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveExctn not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -4178,18 +4094,15 @@ SUBROUTINE WAMIT_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveExctn.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveExctn)>0) OutData%WaveExctn = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveExctn))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveExctn) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveExctn,2), UBOUND(OutData%WaveExctn,2) + DO i1 = LBOUND(OutData%WaveExctn,1), UBOUND(OutData%WaveExctn,1) + OutData%WaveExctn(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - OutData%RhoXg = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%RhoXg = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -4203,18 +4116,13 @@ SUBROUTINE WAMIT_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveTime)>0) OutData%WaveTime = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveTime))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveTime) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) + OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%NStepWave = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NStepWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -4335,20 +4243,20 @@ SUBROUTINE WAMIT_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%PtfmSgF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmSwF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmHvF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmRF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmPF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%PtfmYF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%PtfmSgF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmSgF) + Int_Xferred = Int_Xferred + 1 + OutData%PtfmSwF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmSwF) + Int_Xferred = Int_Xferred + 1 + OutData%PtfmHvF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmHvF) + Int_Xferred = Int_Xferred + 1 + OutData%PtfmRF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmRF) + Int_Xferred = Int_Xferred + 1 + OutData%PtfmPF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmPF) + Int_Xferred = Int_Xferred + 1 + OutData%PtfmYF = TRANSFER(IntKiBuf(Int_Xferred), OutData%PtfmYF) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParam not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -4405,24 +4313,24 @@ SUBROUTINE WAMIT_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumOutAll = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutFmt) - OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%OutSFmt) - OutData%OutSFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Delim) - OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%UnOutFile = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumOutAll = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%OutFmt) + OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%OutSFmt) + OutData%OutSFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%Delim) + OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%UnOutFile = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE WAMIT_UnPackParam SUBROUTINE WAMIT_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -4579,12 +4487,6 @@ SUBROUTINE WAMIT_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_UnPackInput' @@ -4810,8 +4712,10 @@ SUBROUTINE WAMIT_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WriteOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WriteOutput))-1 ) = PACK(InData%WriteOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WriteOutput) + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE WAMIT_PackOutput @@ -4828,12 +4732,6 @@ SUBROUTINE WAMIT_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -4901,15 +4799,10 @@ SUBROUTINE WAMIT_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WriteOutput)>0) OutData%WriteOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WriteOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WriteOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE WAMIT_UnPackOutput @@ -4988,8 +4881,8 @@ SUBROUTINE WAMIT_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMs REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -5004,6 +4897,8 @@ SUBROUTINE WAMIT_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(u1%Mesh, u2%Mesh, tin, u_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE WAMIT_Input_ExtrapInterp1 @@ -5035,8 +4930,9 @@ SUBROUTINE WAMIT_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, E REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_Input_ExtrapInterp2' @@ -5058,6 +4954,8 @@ SUBROUTINE WAMIT_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, E CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(u1%Mesh, u2%Mesh, u3%Mesh, tin, u_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE WAMIT_Input_ExtrapInterp2 @@ -5137,12 +5035,12 @@ SUBROUTINE WAMIT_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrM REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -5155,15 +5053,15 @@ SUBROUTINE WAMIT_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(y1%Mesh, y2%Mesh, tin, y_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = -(y1%WriteOutput - y2%WriteOutput)/t(2) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO END IF ! check if allocated END SUBROUTINE WAMIT_Output_ExtrapInterp1 @@ -5194,13 +5092,14 @@ SUBROUTINE WAMIT_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'WAMIT_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -5219,16 +5118,16 @@ SUBROUTINE WAMIT_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(y1%Mesh, y2%Mesh, y3%Mesh, tin, y_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = (t(3)**2*(y1%WriteOutput - y2%WriteOutput) + t(2)**2*(-y1%WriteOutput + y3%WriteOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WriteOutput + t(3)*y2%WriteOutput - t(2)*y3%WriteOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO END IF ! check if allocated END SUBROUTINE WAMIT_Output_ExtrapInterp2 diff --git a/modules/hydrodyn/src/Waves.f90 b/modules/hydrodyn/src/Waves.f90 index 653c138a62..04cdd41e64 100644 --- a/modules/hydrodyn/src/Waves.f90 +++ b/modules/hydrodyn/src/Waves.f90 @@ -714,8 +714,8 @@ SUBROUTINE VariousWaves_Init ( InitInp, InitOut, ErrStat, ErrMsg ) !UNUSED: !REAL(SiKi), PARAMETER :: n_Massel = 3.0 ! Factor used to the scale the peak spectral frequency in order to find the cut-off frequency based on the suggestion in: Massel, S. R., Ocean Surface Waves: Their Physics and Prediction, Advanced Series on Ocean Engineering - Vol. 11, World Scientific Publishing, Singapore - New Jersey - London - Hong Kong, 1996. This reference recommends n_Massel > 3.0 (higher for higher-order wave kinemetics); the ">" designation is accounted for by checking if ( Omega > OmegaCutOff ). REAL(SiKi) :: Omega ! Wave frequency (rad/s) !UNUSED: !REAL(SiKi) :: OmegaCutOff ! Cut-off frequency or upper frequency limit of the wave spectrum beyond which the wave spectrum is zeroed (rad/s) - REAL(SiKi) :: PCurrVxiPz0 ! Partial derivative of CurrVxi with respect to zi at zi = 0 (1/s ) - REAL(SiKi) :: PCurrVyiPz0 ! Partial derivative of CurrVyi with respect to zi at zi = 0 (1/s ) +!UNUSED: ! REAL(SiKi) :: PCurrVxiPz0 ! Partial derivative of CurrVxi with respect to zi at zi = 0 (1/s ) +!UNUSED: ! REAL(SiKi) :: PCurrVyiPz0 ! Partial derivative of CurrVyi with respect to zi at zi = 0 (1/s ) !REAL(SiKi), ALLOCATABLE :: PWaveAcc0HxiPz0(:,:) ! Partial derivative of WaveAcc0Hxi(:) with respect to zi at zi = 0 (1/s^2) !REAL(SiKi), ALLOCATABLE :: PWaveAcc0HyiPz0(:,:) ! Partial derivative of WaveAcc0Hyi(:) with respect to zi at zi = 0 (1/s^2) !REAL(SiKi), ALLOCATABLE :: PWaveAcc0VPz0 (:,:) ! Partial derivative of WaveAcc0V (:) with respect to zi at zi = 0 (1/s^2) @@ -2189,7 +2189,8 @@ SUBROUTINE Waves_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, Init ! subroutine calls as necessary. InitOut%WaveDirMin = InitInp%WaveDir InitOut%WaveDirMax = InitInp%WaveDir - + InitOut%WaveDir = InitInp%WaveDir ! Not sure why there are so many copies of this variable, but InitOut%WaveDir must be set, and isn't in all cases otherwise. + ! Initialize the variables associated with the incident wave: diff --git a/modules/hydrodyn/src/Waves2.txt b/modules/hydrodyn/src/Waves2.txt index d0b712d8ab..71aa3c56ad 100644 --- a/modules/hydrodyn/src/Waves2.txt +++ b/modules/hydrodyn/src/Waves2.txt @@ -137,7 +137,7 @@ typedef ^ ^ INTEGER NumOuts typedef ^ ^ INTEGER NumOutAll - - - "" - typedef ^ ^ CHARACTER(20) OutFmt - - - "" - typedef ^ ^ CHARACTER(20) OutSFmt - - - "" - -typedef ^ ^ CHARACTER(10) Delim - - - "" - +typedef ^ ^ CHARACTER(ChanLen) Delim - - - "" - typedef ^ ^ INTEGER UnOutFile - - - "" - diff --git a/modules/hydrodyn/src/Waves2_Types.f90 b/modules/hydrodyn/src/Waves2_Types.f90 index 834dcd954f..affe3fdc41 100644 --- a/modules/hydrodyn/src/Waves2_Types.f90 +++ b/modules/hydrodyn/src/Waves2_Types.f90 @@ -127,7 +127,7 @@ MODULE Waves2_Types INTEGER(IntKi) :: NumOutAll !< [-] CHARACTER(20) :: OutFmt !< [-] CHARACTER(20) :: OutSFmt !< [-] - CHARACTER(10) :: Delim !< [-] + CHARACTER(ChanLen) :: Delim !< [-] INTEGER(IntKi) :: UnOutFile !< [-] END TYPE Waves2_ParameterType ! ======================= @@ -460,24 +460,24 @@ SUBROUTINE Waves2_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UnSum - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WtrDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NStepWave2 - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WaveDOmega - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WaveStMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%WaveMultiDir , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%UnSum + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Gravity + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDens + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDpth + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepWave + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepWave2 + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WaveDOmega + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WaveStMod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%WaveMultiDir, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WaveDirArr) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -488,8 +488,10 @@ SUBROUTINE Waves2_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDirArr,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveDirArr)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveDirArr))-1 ) = PACK(InData%WaveDirArr,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveDirArr) + DO i1 = LBOUND(InData%WaveDirArr,1), UBOUND(InData%WaveDirArr,1) + ReKiBuf(Re_Xferred) = InData%WaveDirArr(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveElevC0) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -504,8 +506,12 @@ SUBROUTINE Waves2_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC0,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElevC0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElevC0))-1 ) = PACK(InData%WaveElevC0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElevC0) + DO i2 = LBOUND(InData%WaveElevC0,2), UBOUND(InData%WaveElevC0,2) + DO i1 = LBOUND(InData%WaveElevC0,1), UBOUND(InData%WaveElevC0,1) + ReKiBuf(Re_Xferred) = InData%WaveElevC0(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveTime) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -517,11 +523,13 @@ SUBROUTINE Waves2_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveTime)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveTime))-1 ) = PACK(InData%WaveTime,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveTime) + DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) + ReKiBuf(Re_Xferred) = InData%WaveTime(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NWaveElev - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NWaveElev + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WaveElevxi) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -532,8 +540,10 @@ SUBROUTINE Waves2_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevxi,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElevxi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElevxi))-1 ) = PACK(InData%WaveElevxi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElevxi) + DO i1 = LBOUND(InData%WaveElevxi,1), UBOUND(InData%WaveElevxi,1) + ReKiBuf(Re_Xferred) = InData%WaveElevxi(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveElevyi) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -545,8 +555,10 @@ SUBROUTINE Waves2_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevyi,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElevyi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElevyi))-1 ) = PACK(InData%WaveElevyi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElevyi) + DO i1 = LBOUND(InData%WaveElevyi,1), UBOUND(InData%WaveElevyi,1) + ReKiBuf(Re_Xferred) = InData%WaveElevyi(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveElevXY) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -561,11 +573,15 @@ SUBROUTINE Waves2_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevXY,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElevXY)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElevXY))-1 ) = PACK(InData%WaveElevXY,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElevXY) + DO i2 = LBOUND(InData%WaveElevXY,2), UBOUND(InData%WaveElevXY,2) + DO i1 = LBOUND(InData%WaveElevXY,1), UBOUND(InData%WaveElevXY,1) + ReKiBuf(Re_Xferred) = InData%WaveElevXY(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NWaveKin - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NWaveKin + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WaveKinxi) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -576,8 +592,10 @@ SUBROUTINE Waves2_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveKinxi,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveKinxi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveKinxi))-1 ) = PACK(InData%WaveKinxi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveKinxi) + DO i1 = LBOUND(InData%WaveKinxi,1), UBOUND(InData%WaveKinxi,1) + ReKiBuf(Re_Xferred) = InData%WaveKinxi(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveKinyi) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -589,8 +607,10 @@ SUBROUTINE Waves2_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveKinyi,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveKinyi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveKinyi))-1 ) = PACK(InData%WaveKinyi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveKinyi) + DO i1 = LBOUND(InData%WaveKinyi,1), UBOUND(InData%WaveKinyi,1) + ReKiBuf(Re_Xferred) = InData%WaveKinyi(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveKinzi) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -602,33 +622,35 @@ SUBROUTINE Waves2_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveKinzi,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveKinzi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveKinzi))-1 ) = PACK(InData%WaveKinzi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveKinzi) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%WvDiffQTFF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%WvSumQTFF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WvLowCOffD - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WvHiCOffD - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WvLowCOffS - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WvHiCOffS - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%WaveKinzi,1), UBOUND(InData%WaveKinzi,1) + ReKiBuf(Re_Xferred) = InData%WaveKinzi(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IntKiBuf(Int_Xferred) = TRANSFER(InData%WvDiffQTFF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%WvSumQTFF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WvLowCOffD + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WvHiCOffD + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WvLowCOffS + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WvHiCOffS + Re_Xferred = Re_Xferred + 1 DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) - DO I = 1, LEN(InData%OutList) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%OutAll , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOutAll - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%OutList) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + IntKiBuf(Int_Xferred) = TRANSFER(InData%OutAll, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOutAll + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Waves2_PackInitInput SUBROUTINE Waves2_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -644,12 +666,6 @@ SUBROUTINE Waves2_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (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 @@ -666,24 +682,24 @@ SUBROUTINE Waves2_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%UnSum = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%Gravity = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDpth = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%NStepWave = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NStepWave2 = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%WaveDOmega = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveStMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%WaveMultiDir = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%UnSum = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%Gravity = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WtrDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WtrDpth = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%NStepWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NStepWave2 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WaveDOmega = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WaveStMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WaveMultiDir = TRANSFER(IntKiBuf(Int_Xferred), OutData%WaveMultiDir) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDirArr not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -697,15 +713,10 @@ SUBROUTINE Waves2_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDirArr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveDirArr)>0) OutData%WaveDirArr = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveDirArr))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveDirArr) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveDirArr,1), UBOUND(OutData%WaveDirArr,1) + OutData%WaveDirArr(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevC0 not allocated Int_Xferred = Int_Xferred + 1 @@ -723,15 +734,12 @@ SUBROUTINE Waves2_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveElevC0)>0) OutData%WaveElevC0 = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElevC0))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElevC0) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveElevC0,2), UBOUND(OutData%WaveElevC0,2) + DO i1 = LBOUND(OutData%WaveElevC0,1), UBOUND(OutData%WaveElevC0,1) + OutData%WaveElevC0(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated Int_Xferred = Int_Xferred + 1 @@ -746,18 +754,13 @@ SUBROUTINE Waves2_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveTime)>0) OutData%WaveTime = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveTime))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveTime) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) + OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%NWaveElev = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NWaveElev = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevxi not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -771,15 +774,10 @@ SUBROUTINE Waves2_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevxi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveElevxi)>0) OutData%WaveElevxi = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElevxi))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElevxi) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveElevxi,1), UBOUND(OutData%WaveElevxi,1) + OutData%WaveElevxi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevyi not allocated Int_Xferred = Int_Xferred + 1 @@ -794,15 +792,10 @@ SUBROUTINE Waves2_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevyi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveElevyi)>0) OutData%WaveElevyi = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElevyi))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElevyi) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveElevyi,1), UBOUND(OutData%WaveElevyi,1) + OutData%WaveElevyi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevXY not allocated Int_Xferred = Int_Xferred + 1 @@ -820,18 +813,15 @@ SUBROUTINE Waves2_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevXY.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveElevXY)>0) OutData%WaveElevXY = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElevXY))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElevXY) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveElevXY,2), UBOUND(OutData%WaveElevXY,2) + DO i1 = LBOUND(OutData%WaveElevXY,1), UBOUND(OutData%WaveElevXY,1) + OutData%WaveElevXY(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - OutData%NWaveKin = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NWaveKin = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveKinxi not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -845,15 +835,10 @@ SUBROUTINE Waves2_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinxi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveKinxi)>0) OutData%WaveKinxi = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveKinxi))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveKinxi) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveKinxi,1), UBOUND(OutData%WaveKinxi,1) + OutData%WaveKinxi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveKinyi not allocated Int_Xferred = Int_Xferred + 1 @@ -868,15 +853,10 @@ SUBROUTINE Waves2_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinyi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveKinyi)>0) OutData%WaveKinyi = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveKinyi))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveKinyi) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveKinyi,1), UBOUND(OutData%WaveKinyi,1) + OutData%WaveKinyi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveKinzi not allocated Int_Xferred = Int_Xferred + 1 @@ -891,49 +871,37 @@ SUBROUTINE Waves2_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinzi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveKinzi)>0) OutData%WaveKinzi = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveKinzi))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveKinzi) - DEALLOCATE(mask1) - END IF - OutData%WvDiffQTFF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%WvSumQTFF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%WvLowCOffD = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WvHiCOffD = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WvLowCOffS = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WvHiCOffS = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%WaveKinzi,1), UBOUND(OutData%WaveKinzi,1) + OutData%WaveKinzi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%WvDiffQTFF = TRANSFER(IntKiBuf(Int_Xferred), OutData%WvDiffQTFF) + Int_Xferred = Int_Xferred + 1 + OutData%WvSumQTFF = TRANSFER(IntKiBuf(Int_Xferred), OutData%WvSumQTFF) + Int_Xferred = Int_Xferred + 1 + OutData%WvLowCOffD = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WvHiCOffD = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WvLowCOffS = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WvHiCOffS = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%OutList,1) i1_u = UBOUND(OutData%OutList,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) - DO I = 1, LEN(OutData%OutList) - OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - DEALLOCATE(mask1) - OutData%OutAll = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumOutAll = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%OutList) + OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + OutData%OutAll = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutAll) + Int_Xferred = Int_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumOutAll = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Waves2_UnPackInitInput SUBROUTINE Waves2_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -1380,12 +1348,12 @@ SUBROUTINE Waves2_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1397,12 +1365,12 @@ SUBROUTINE Waves2_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveElevSeries2) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1417,8 +1385,12 @@ SUBROUTINE Waves2_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevSeries2,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElevSeries2)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElevSeries2))-1 ) = PACK(InData%WaveElevSeries2,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElevSeries2) + DO i2 = LBOUND(InData%WaveElevSeries2,2), UBOUND(InData%WaveElevSeries2,2) + DO i1 = LBOUND(InData%WaveElevSeries2,1), UBOUND(InData%WaveElevSeries2,1) + ReKiBuf(Re_Xferred) = InData%WaveElevSeries2(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveAcc2D) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1436,8 +1408,14 @@ SUBROUTINE Waves2_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc2D,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveAcc2D)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveAcc2D))-1 ) = PACK(InData%WaveAcc2D,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveAcc2D) + DO i3 = LBOUND(InData%WaveAcc2D,3), UBOUND(InData%WaveAcc2D,3) + DO i2 = LBOUND(InData%WaveAcc2D,2), UBOUND(InData%WaveAcc2D,2) + DO i1 = LBOUND(InData%WaveAcc2D,1), UBOUND(InData%WaveAcc2D,1) + ReKiBuf(Re_Xferred) = InData%WaveAcc2D(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveDynP2D) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1452,8 +1430,12 @@ SUBROUTINE Waves2_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP2D,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveDynP2D)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveDynP2D))-1 ) = PACK(InData%WaveDynP2D,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveDynP2D) + DO i2 = LBOUND(InData%WaveDynP2D,2), UBOUND(InData%WaveDynP2D,2) + DO i1 = LBOUND(InData%WaveDynP2D,1), UBOUND(InData%WaveDynP2D,1) + ReKiBuf(Re_Xferred) = InData%WaveDynP2D(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveAcc2S) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1471,8 +1453,14 @@ SUBROUTINE Waves2_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc2S,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveAcc2S)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveAcc2S))-1 ) = PACK(InData%WaveAcc2S,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveAcc2S) + DO i3 = LBOUND(InData%WaveAcc2S,3), UBOUND(InData%WaveAcc2S,3) + DO i2 = LBOUND(InData%WaveAcc2S,2), UBOUND(InData%WaveAcc2S,2) + DO i1 = LBOUND(InData%WaveAcc2S,1), UBOUND(InData%WaveAcc2S,1) + ReKiBuf(Re_Xferred) = InData%WaveAcc2S(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveDynP2S) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1487,8 +1475,12 @@ SUBROUTINE Waves2_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP2S,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveDynP2S)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveDynP2S))-1 ) = PACK(InData%WaveDynP2S,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveDynP2S) + DO i2 = LBOUND(InData%WaveDynP2S,2), UBOUND(InData%WaveDynP2S,2) + DO i1 = LBOUND(InData%WaveDynP2S,1), UBOUND(InData%WaveDynP2S,1) + ReKiBuf(Re_Xferred) = InData%WaveDynP2S(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveVel2D) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1506,8 +1498,14 @@ SUBROUTINE Waves2_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel2D,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveVel2D)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveVel2D))-1 ) = PACK(InData%WaveVel2D,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveVel2D) + DO i3 = LBOUND(InData%WaveVel2D,3), UBOUND(InData%WaveVel2D,3) + DO i2 = LBOUND(InData%WaveVel2D,2), UBOUND(InData%WaveVel2D,2) + DO i1 = LBOUND(InData%WaveVel2D,1), UBOUND(InData%WaveVel2D,1) + ReKiBuf(Re_Xferred) = InData%WaveVel2D(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveVel2S) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1525,8 +1523,14 @@ SUBROUTINE Waves2_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel2S,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveVel2S)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveVel2S))-1 ) = PACK(InData%WaveVel2S,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveVel2S) + DO i3 = LBOUND(InData%WaveVel2S,3), UBOUND(InData%WaveVel2S,3) + DO i2 = LBOUND(InData%WaveVel2S,2), UBOUND(InData%WaveVel2S,2) + DO i1 = LBOUND(InData%WaveVel2S,1), UBOUND(InData%WaveVel2S,1) + ReKiBuf(Re_Xferred) = InData%WaveVel2S(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveAcc2D0) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1544,8 +1548,14 @@ SUBROUTINE Waves2_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc2D0,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveAcc2D0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveAcc2D0))-1 ) = PACK(InData%WaveAcc2D0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveAcc2D0) + DO i3 = LBOUND(InData%WaveAcc2D0,3), UBOUND(InData%WaveAcc2D0,3) + DO i2 = LBOUND(InData%WaveAcc2D0,2), UBOUND(InData%WaveAcc2D0,2) + DO i1 = LBOUND(InData%WaveAcc2D0,1), UBOUND(InData%WaveAcc2D0,1) + ReKiBuf(Re_Xferred) = InData%WaveAcc2D0(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveDynP2D0) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1560,8 +1570,12 @@ SUBROUTINE Waves2_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP2D0,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveDynP2D0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveDynP2D0))-1 ) = PACK(InData%WaveDynP2D0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveDynP2D0) + DO i2 = LBOUND(InData%WaveDynP2D0,2), UBOUND(InData%WaveDynP2D0,2) + DO i1 = LBOUND(InData%WaveDynP2D0,1), UBOUND(InData%WaveDynP2D0,1) + ReKiBuf(Re_Xferred) = InData%WaveDynP2D0(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveAcc2S0) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1579,8 +1593,14 @@ SUBROUTINE Waves2_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc2S0,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveAcc2S0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveAcc2S0))-1 ) = PACK(InData%WaveAcc2S0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveAcc2S0) + DO i3 = LBOUND(InData%WaveAcc2S0,3), UBOUND(InData%WaveAcc2S0,3) + DO i2 = LBOUND(InData%WaveAcc2S0,2), UBOUND(InData%WaveAcc2S0,2) + DO i1 = LBOUND(InData%WaveAcc2S0,1), UBOUND(InData%WaveAcc2S0,1) + ReKiBuf(Re_Xferred) = InData%WaveAcc2S0(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveDynP2S0) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1595,8 +1615,12 @@ SUBROUTINE Waves2_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP2S0,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveDynP2S0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveDynP2S0))-1 ) = PACK(InData%WaveDynP2S0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveDynP2S0) + DO i2 = LBOUND(InData%WaveDynP2S0,2), UBOUND(InData%WaveDynP2S0,2) + DO i1 = LBOUND(InData%WaveDynP2S0,1), UBOUND(InData%WaveDynP2S0,1) + ReKiBuf(Re_Xferred) = InData%WaveDynP2S0(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveVel2D0) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1614,8 +1638,14 @@ SUBROUTINE Waves2_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel2D0,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveVel2D0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveVel2D0))-1 ) = PACK(InData%WaveVel2D0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveVel2D0) + DO i3 = LBOUND(InData%WaveVel2D0,3), UBOUND(InData%WaveVel2D0,3) + DO i2 = LBOUND(InData%WaveVel2D0,2), UBOUND(InData%WaveVel2D0,2) + DO i1 = LBOUND(InData%WaveVel2D0,1), UBOUND(InData%WaveVel2D0,1) + ReKiBuf(Re_Xferred) = InData%WaveVel2D0(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveVel2S0) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1633,8 +1663,14 @@ SUBROUTINE Waves2_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel2S0,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveVel2S0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveVel2S0))-1 ) = PACK(InData%WaveVel2S0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveVel2S0) + DO i3 = LBOUND(InData%WaveVel2S0,3), UBOUND(InData%WaveVel2S0,3) + DO i2 = LBOUND(InData%WaveVel2S0,2), UBOUND(InData%WaveVel2S0,2) + DO i1 = LBOUND(InData%WaveVel2S0,1), UBOUND(InData%WaveVel2S0,1) + ReKiBuf(Re_Xferred) = InData%WaveVel2S0(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF END SUBROUTINE Waves2_PackInitOutput @@ -1651,12 +1687,6 @@ SUBROUTINE Waves2_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (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 @@ -1686,19 +1716,12 @@ SUBROUTINE Waves2_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated Int_Xferred = Int_Xferred + 1 @@ -1713,19 +1736,12 @@ SUBROUTINE Waves2_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevSeries2 not allocated Int_Xferred = Int_Xferred + 1 @@ -1743,15 +1759,12 @@ SUBROUTINE Waves2_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevSeries2.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveElevSeries2)>0) OutData%WaveElevSeries2 = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElevSeries2))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElevSeries2) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveElevSeries2,2), UBOUND(OutData%WaveElevSeries2,2) + DO i1 = LBOUND(OutData%WaveElevSeries2,1), UBOUND(OutData%WaveElevSeries2,1) + OutData%WaveElevSeries2(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAcc2D not allocated Int_Xferred = Int_Xferred + 1 @@ -1772,15 +1785,14 @@ SUBROUTINE Waves2_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc2D.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%WaveAcc2D)>0) OutData%WaveAcc2D = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveAcc2D))-1 ), mask3, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveAcc2D) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%WaveAcc2D,3), UBOUND(OutData%WaveAcc2D,3) + DO i2 = LBOUND(OutData%WaveAcc2D,2), UBOUND(OutData%WaveAcc2D,2) + DO i1 = LBOUND(OutData%WaveAcc2D,1), UBOUND(OutData%WaveAcc2D,1) + OutData%WaveAcc2D(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDynP2D not allocated Int_Xferred = Int_Xferred + 1 @@ -1798,15 +1810,12 @@ SUBROUTINE Waves2_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP2D.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveDynP2D)>0) OutData%WaveDynP2D = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveDynP2D))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveDynP2D) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveDynP2D,2), UBOUND(OutData%WaveDynP2D,2) + DO i1 = LBOUND(OutData%WaveDynP2D,1), UBOUND(OutData%WaveDynP2D,1) + OutData%WaveDynP2D(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAcc2S not allocated Int_Xferred = Int_Xferred + 1 @@ -1827,15 +1836,14 @@ SUBROUTINE Waves2_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc2S.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%WaveAcc2S)>0) OutData%WaveAcc2S = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveAcc2S))-1 ), mask3, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveAcc2S) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%WaveAcc2S,3), UBOUND(OutData%WaveAcc2S,3) + DO i2 = LBOUND(OutData%WaveAcc2S,2), UBOUND(OutData%WaveAcc2S,2) + DO i1 = LBOUND(OutData%WaveAcc2S,1), UBOUND(OutData%WaveAcc2S,1) + OutData%WaveAcc2S(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDynP2S not allocated Int_Xferred = Int_Xferred + 1 @@ -1853,15 +1861,12 @@ SUBROUTINE Waves2_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP2S.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveDynP2S)>0) OutData%WaveDynP2S = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveDynP2S))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveDynP2S) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveDynP2S,2), UBOUND(OutData%WaveDynP2S,2) + DO i1 = LBOUND(OutData%WaveDynP2S,1), UBOUND(OutData%WaveDynP2S,1) + OutData%WaveDynP2S(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveVel2D not allocated Int_Xferred = Int_Xferred + 1 @@ -1882,15 +1887,14 @@ SUBROUTINE Waves2_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel2D.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%WaveVel2D)>0) OutData%WaveVel2D = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveVel2D))-1 ), mask3, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveVel2D) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%WaveVel2D,3), UBOUND(OutData%WaveVel2D,3) + DO i2 = LBOUND(OutData%WaveVel2D,2), UBOUND(OutData%WaveVel2D,2) + DO i1 = LBOUND(OutData%WaveVel2D,1), UBOUND(OutData%WaveVel2D,1) + OutData%WaveVel2D(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveVel2S not allocated Int_Xferred = Int_Xferred + 1 @@ -1911,15 +1915,14 @@ SUBROUTINE Waves2_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel2S.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%WaveVel2S)>0) OutData%WaveVel2S = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveVel2S))-1 ), mask3, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveVel2S) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%WaveVel2S,3), UBOUND(OutData%WaveVel2S,3) + DO i2 = LBOUND(OutData%WaveVel2S,2), UBOUND(OutData%WaveVel2S,2) + DO i1 = LBOUND(OutData%WaveVel2S,1), UBOUND(OutData%WaveVel2S,1) + OutData%WaveVel2S(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAcc2D0 not allocated Int_Xferred = Int_Xferred + 1 @@ -1940,15 +1943,14 @@ SUBROUTINE Waves2_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc2D0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%WaveAcc2D0)>0) OutData%WaveAcc2D0 = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveAcc2D0))-1 ), mask3, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveAcc2D0) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%WaveAcc2D0,3), UBOUND(OutData%WaveAcc2D0,3) + DO i2 = LBOUND(OutData%WaveAcc2D0,2), UBOUND(OutData%WaveAcc2D0,2) + DO i1 = LBOUND(OutData%WaveAcc2D0,1), UBOUND(OutData%WaveAcc2D0,1) + OutData%WaveAcc2D0(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDynP2D0 not allocated Int_Xferred = Int_Xferred + 1 @@ -1966,15 +1968,12 @@ SUBROUTINE Waves2_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP2D0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveDynP2D0)>0) OutData%WaveDynP2D0 = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveDynP2D0))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveDynP2D0) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveDynP2D0,2), UBOUND(OutData%WaveDynP2D0,2) + DO i1 = LBOUND(OutData%WaveDynP2D0,1), UBOUND(OutData%WaveDynP2D0,1) + OutData%WaveDynP2D0(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAcc2S0 not allocated Int_Xferred = Int_Xferred + 1 @@ -1995,15 +1994,14 @@ SUBROUTINE Waves2_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc2S0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%WaveAcc2S0)>0) OutData%WaveAcc2S0 = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveAcc2S0))-1 ), mask3, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveAcc2S0) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%WaveAcc2S0,3), UBOUND(OutData%WaveAcc2S0,3) + DO i2 = LBOUND(OutData%WaveAcc2S0,2), UBOUND(OutData%WaveAcc2S0,2) + DO i1 = LBOUND(OutData%WaveAcc2S0,1), UBOUND(OutData%WaveAcc2S0,1) + OutData%WaveAcc2S0(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDynP2S0 not allocated Int_Xferred = Int_Xferred + 1 @@ -2021,15 +2019,12 @@ SUBROUTINE Waves2_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP2S0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveDynP2S0)>0) OutData%WaveDynP2S0 = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveDynP2S0))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveDynP2S0) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveDynP2S0,2), UBOUND(OutData%WaveDynP2S0,2) + DO i1 = LBOUND(OutData%WaveDynP2S0,1), UBOUND(OutData%WaveDynP2S0,1) + OutData%WaveDynP2S0(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveVel2D0 not allocated Int_Xferred = Int_Xferred + 1 @@ -2050,15 +2045,14 @@ SUBROUTINE Waves2_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel2D0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%WaveVel2D0)>0) OutData%WaveVel2D0 = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveVel2D0))-1 ), mask3, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveVel2D0) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%WaveVel2D0,3), UBOUND(OutData%WaveVel2D0,3) + DO i2 = LBOUND(OutData%WaveVel2D0,2), UBOUND(OutData%WaveVel2D0,2) + DO i1 = LBOUND(OutData%WaveVel2D0,1), UBOUND(OutData%WaveVel2D0,1) + OutData%WaveVel2D0(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveVel2S0 not allocated Int_Xferred = Int_Xferred + 1 @@ -2079,15 +2073,14 @@ SUBROUTINE Waves2_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel2S0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%WaveVel2S0)>0) OutData%WaveVel2S0 = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveVel2S0))-1 ), mask3, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveVel2S0) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%WaveVel2S0,3), UBOUND(OutData%WaveVel2S0,3) + DO i2 = LBOUND(OutData%WaveVel2S0,2), UBOUND(OutData%WaveVel2S0,2) + DO i1 = LBOUND(OutData%WaveVel2S0,1), UBOUND(OutData%WaveVel2S0,1) + OutData%WaveVel2S0(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF END SUBROUTINE Waves2_UnPackInitOutput @@ -2182,8 +2175,8 @@ SUBROUTINE Waves2_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyContState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyContState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Waves2_PackContState SUBROUTINE Waves2_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2199,12 +2192,6 @@ SUBROUTINE Waves2_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_UnPackContState' @@ -2218,8 +2205,8 @@ SUBROUTINE Waves2_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyContState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyContState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Waves2_UnPackContState SUBROUTINE Waves2_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) @@ -2313,8 +2300,8 @@ SUBROUTINE Waves2_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyDiscState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyDiscState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Waves2_PackDiscState SUBROUTINE Waves2_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2330,12 +2317,6 @@ SUBROUTINE Waves2_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_UnPackDiscState' @@ -2349,8 +2330,8 @@ SUBROUTINE Waves2_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyDiscState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyDiscState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Waves2_UnPackDiscState SUBROUTINE Waves2_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) @@ -2444,8 +2425,8 @@ SUBROUTINE Waves2_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyConstrState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Waves2_PackConstrState SUBROUTINE Waves2_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2461,12 +2442,6 @@ SUBROUTINE Waves2_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_UnPackConstrState' @@ -2480,8 +2455,8 @@ SUBROUTINE Waves2_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyConstrState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyConstrState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Waves2_UnPackConstrState SUBROUTINE Waves2_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -2575,8 +2550,8 @@ SUBROUTINE Waves2_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DummyOtherState - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DummyOtherState + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Waves2_PackOtherState SUBROUTINE Waves2_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2592,12 +2567,6 @@ SUBROUTINE Waves2_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_UnPackOtherState' @@ -2611,8 +2580,8 @@ SUBROUTINE Waves2_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyOtherState = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%DummyOtherState = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Waves2_UnPackOtherState SUBROUTINE Waves2_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) @@ -2706,8 +2675,8 @@ SUBROUTINE Waves2_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%LastIndWave - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%LastIndWave + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Waves2_PackMisc SUBROUTINE Waves2_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2723,12 +2692,6 @@ SUBROUTINE Waves2_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_UnPackMisc' @@ -2742,8 +2705,8 @@ SUBROUTINE Waves2_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%LastIndWave = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%LastIndWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Waves2_UnPackMisc SUBROUTINE Waves2_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -2949,18 +2912,18 @@ SUBROUTINE Waves2_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%WvDiffQTFF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%WvSumQTFF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NWaveElev - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NStepWave2 - Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%WvDiffQTFF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%WvSumQTFF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NWaveElev + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepWave + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepWave2 + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WaveTime) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2971,8 +2934,10 @@ SUBROUTINE Waves2_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveTime)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveTime))-1 ) = PACK(InData%WaveTime,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveTime) + DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) + ReKiBuf(Re_Xferred) = InData%WaveTime(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveElev2) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2987,8 +2952,12 @@ SUBROUTINE Waves2_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev2,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElev2)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElev2))-1 ) = PACK(InData%WaveElev2,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElev2) + DO i2 = LBOUND(InData%WaveElev2,2), UBOUND(InData%WaveElev2,2) + DO i1 = LBOUND(InData%WaveElev2,1), UBOUND(InData%WaveElev2,1) + ReKiBuf(Re_Xferred) = InData%WaveElev2(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%OutParam) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3031,24 +3000,24 @@ SUBROUTINE Waves2_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg ENDIF END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOutAll - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%OutSFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutSFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%Delim) - IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UnOutFile - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOutAll + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%OutFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%OutSFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutSFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%Delim) + IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%UnOutFile + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Waves2_PackParam SUBROUTINE Waves2_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -3064,12 +3033,6 @@ SUBROUTINE Waves2_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -3085,18 +3048,18 @@ SUBROUTINE Waves2_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%WvDiffQTFF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%WvSumQTFF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NWaveElev = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NStepWave = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NStepWave2 = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%WvDiffQTFF = TRANSFER(IntKiBuf(Int_Xferred), OutData%WvDiffQTFF) + Int_Xferred = Int_Xferred + 1 + OutData%WvSumQTFF = TRANSFER(IntKiBuf(Int_Xferred), OutData%WvSumQTFF) + Int_Xferred = Int_Xferred + 1 + OutData%NWaveElev = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NStepWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NStepWave2 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3110,15 +3073,10 @@ SUBROUTINE Waves2_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveTime)>0) OutData%WaveTime = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveTime))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveTime) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) + OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev2 not allocated Int_Xferred = Int_Xferred + 1 @@ -3136,15 +3094,12 @@ SUBROUTINE Waves2_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev2.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveElev2)>0) OutData%WaveElev2 = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElev2))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElev2) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveElev2,2), UBOUND(OutData%WaveElev2,2) + DO i1 = LBOUND(OutData%WaveElev2,1), UBOUND(OutData%WaveElev2,1) + OutData%WaveElev2(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParam not allocated Int_Xferred = Int_Xferred + 1 @@ -3202,24 +3157,24 @@ SUBROUTINE Waves2_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumOutAll = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutFmt) - OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%OutSFmt) - OutData%OutSFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Delim) - OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%UnOutFile = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumOutAll = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%OutFmt) + OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%OutSFmt) + OutData%OutSFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%Delim) + OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%UnOutFile = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Waves2_UnPackParam SUBROUTINE Waves2_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -3313,8 +3268,8 @@ SUBROUTINE Waves2_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyInput - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyInput + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Waves2_PackInput SUBROUTINE Waves2_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -3330,12 +3285,6 @@ SUBROUTINE Waves2_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_UnPackInput' @@ -3349,8 +3298,8 @@ SUBROUTINE Waves2_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyInput = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyInput = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Waves2_UnPackInput SUBROUTINE Waves2_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -3473,8 +3422,10 @@ SUBROUTINE Waves2_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WriteOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WriteOutput))-1 ) = PACK(InData%WriteOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WriteOutput) + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE Waves2_PackOutput @@ -3491,12 +3442,6 @@ SUBROUTINE Waves2_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -3524,15 +3469,10 @@ SUBROUTINE Waves2_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WriteOutput)>0) OutData%WriteOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WriteOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WriteOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE Waves2_UnPackOutput @@ -3611,8 +3551,8 @@ SUBROUTINE Waves2_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrM REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -3627,8 +3567,10 @@ SUBROUTINE Waves2_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - b0 = -(u1%DummyInput - u2%DummyInput)/t(2) - u_out%DummyInput = u1%DummyInput + b0 * t_out + + ScaleFactor = t_out / t(2) + b = -(u1%DummyInput - u2%DummyInput) + u_out%DummyInput = u1%DummyInput + b * ScaleFactor END SUBROUTINE Waves2_Input_ExtrapInterp1 @@ -3658,8 +3600,9 @@ SUBROUTINE Waves2_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_Input_ExtrapInterp2' @@ -3681,9 +3624,11 @@ SUBROUTINE Waves2_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - b0 = (t(3)**2*(u1%DummyInput - u2%DummyInput) + t(2)**2*(-u1%DummyInput + u3%DummyInput))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%DummyInput + t(3)*u2%DummyInput - t(2)*u3%DummyInput ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%DummyInput = u1%DummyInput + b0 * t_out + c0 * t_out**2 + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) + b = (t(3)**2*(u1%DummyInput - u2%DummyInput) + t(2)**2*(-u1%DummyInput + u3%DummyInput))* scaleFactor + c = ( (t(2)-t(3))*u1%DummyInput + t(3)*u2%DummyInput - t(2)*u3%DummyInput ) * scaleFactor + u_out%DummyInput = u1%DummyInput + b + c * t_out END SUBROUTINE Waves2_Input_ExtrapInterp2 @@ -3761,12 +3706,12 @@ SUBROUTINE Waves2_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, Err REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -3779,13 +3724,13 @@ SUBROUTINE Waves2_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = -(y1%WriteOutput - y2%WriteOutput)/t(2) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO END IF ! check if allocated END SUBROUTINE Waves2_Output_ExtrapInterp1 @@ -3816,13 +3761,14 @@ SUBROUTINE Waves2_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'Waves2_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -3841,14 +3787,14 @@ SUBROUTINE Waves2_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = (t(3)**2*(y1%WriteOutput - y2%WriteOutput) + t(2)**2*(-y1%WriteOutput + y3%WriteOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WriteOutput + t(3)*y2%WriteOutput - t(2)*y3%WriteOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO END IF ! check if allocated END SUBROUTINE Waves2_Output_ExtrapInterp2 diff --git a/modules/hydrodyn/src/Waves_Types.f90 b/modules/hydrodyn/src/Waves_Types.f90 index e5ecef1ea4..ede51633d8 100644 --- a/modules/hydrodyn/src/Waves_Types.f90 +++ b/modules/hydrodyn/src/Waves_Types.f90 @@ -471,76 +471,78 @@ SUBROUTINE Waves_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%DirRoot) - IntKiBuf(Int_Xferred) = ICHAR(InData%DirRoot(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%WvKinFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%WvKinFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%WriteWvKin , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UnSum - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MSL2SWL - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WvLowCOff - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WvHiCOff - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WaveDir - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WaveNDir - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%WaveMultiDir , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WaveDirMod - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WaveDirSpread - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WaveDirRange - Re_Xferred = Re_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%WaveDT - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WaveHs - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WaveMod - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%WaveModChr) - IntKiBuf(Int_Xferred) = ICHAR(InData%WaveModChr(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%WaveNDAmp , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WavePhase - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WavePkShp - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%WavePkShpChr) - IntKiBuf(Int_Xferred) = ICHAR(InData%WavePkShpChr(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%WaveSeed))-1 ) = PACK(InData%WaveSeed,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%WaveSeed) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WaveStMod - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%WaveTMax - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WaveTp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WtrDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NWaveElev - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%InputFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%DirRoot) + IntKiBuf(Int_Xferred) = ICHAR(InData%DirRoot(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%WvKinFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%WvKinFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%WriteWvKin, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%UnSum + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Gravity + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MSL2SWL + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WvLowCOff + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WvHiCOff + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WaveDir + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WaveNDir + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%WaveMultiDir, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WaveDirMod + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WaveDirSpread + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WaveDirRange + Re_Xferred = Re_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%WaveDT + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WaveHs + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WaveMod + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%WaveModChr) + IntKiBuf(Int_Xferred) = ICHAR(InData%WaveModChr(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%WaveNDAmp, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WavePhase + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WavePkShp + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(InData%WavePkShpChr) + IntKiBuf(Int_Xferred) = ICHAR(InData%WavePkShpChr(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO i1 = LBOUND(InData%WaveSeed,1), UBOUND(InData%WaveSeed,1) + IntKiBuf(Int_Xferred) = InData%WaveSeed(i1) + Int_Xferred = Int_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%WaveStMod + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%WaveTMax + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WaveTp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDens + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDpth + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NWaveElev + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WaveElevxi) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -551,8 +553,10 @@ SUBROUTINE Waves_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevxi,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElevxi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElevxi))-1 ) = PACK(InData%WaveElevxi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElevxi) + DO i1 = LBOUND(InData%WaveElevxi,1), UBOUND(InData%WaveElevxi,1) + ReKiBuf(Re_Xferred) = InData%WaveElevxi(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveElevyi) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -564,8 +568,10 @@ SUBROUTINE Waves_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevyi,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElevyi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElevyi))-1 ) = PACK(InData%WaveElevyi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElevyi) + DO i1 = LBOUND(InData%WaveElevyi,1), UBOUND(InData%WaveElevyi,1) + ReKiBuf(Re_Xferred) = InData%WaveElevyi(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveElevXY) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -580,11 +586,15 @@ SUBROUTINE Waves_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevXY,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElevXY)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElevXY))-1 ) = PACK(InData%WaveElevXY,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElevXY) + DO i2 = LBOUND(InData%WaveElevXY,2), UBOUND(InData%WaveElevXY,2) + DO i1 = LBOUND(InData%WaveElevXY,1), UBOUND(InData%WaveElevXY,1) + ReKiBuf(Re_Xferred) = InData%WaveElevXY(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NWaveKin - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NWaveKin + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WaveKinxi) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -595,8 +605,10 @@ SUBROUTINE Waves_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveKinxi,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveKinxi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveKinxi))-1 ) = PACK(InData%WaveKinxi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveKinxi) + DO i1 = LBOUND(InData%WaveKinxi,1), UBOUND(InData%WaveKinxi,1) + ReKiBuf(Re_Xferred) = InData%WaveKinxi(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveKinyi) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -608,8 +620,10 @@ SUBROUTINE Waves_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveKinyi,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveKinyi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveKinyi))-1 ) = PACK(InData%WaveKinyi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveKinyi) + DO i1 = LBOUND(InData%WaveKinyi,1), UBOUND(InData%WaveKinyi,1) + ReKiBuf(Re_Xferred) = InData%WaveKinyi(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveKinzi) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -621,8 +635,10 @@ SUBROUTINE Waves_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveKinzi,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveKinzi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveKinzi))-1 ) = PACK(InData%WaveKinzi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveKinzi) + DO i1 = LBOUND(InData%WaveKinzi,1), UBOUND(InData%WaveKinzi,1) + ReKiBuf(Re_Xferred) = InData%WaveKinzi(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%CurrVxi) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -634,8 +650,10 @@ SUBROUTINE Waves_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CurrVxi,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CurrVxi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CurrVxi))-1 ) = PACK(InData%CurrVxi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CurrVxi) + DO i1 = LBOUND(InData%CurrVxi,1), UBOUND(InData%CurrVxi,1) + ReKiBuf(Re_Xferred) = InData%CurrVxi(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%CurrVyi) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -647,13 +665,15 @@ SUBROUTINE Waves_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CurrVyi,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CurrVyi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CurrVyi))-1 ) = PACK(InData%CurrVyi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CurrVyi) + DO i1 = LBOUND(InData%CurrVyi,1), UBOUND(InData%CurrVyi,1) + ReKiBuf(Re_Xferred) = InData%CurrVyi(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PCurrVxiPz0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PCurrVyiPz0 - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PCurrVxiPz0 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PCurrVyiPz0 + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Waves_PackInitInput SUBROUTINE Waves_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -669,12 +689,6 @@ SUBROUTINE Waves_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (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 @@ -691,85 +705,80 @@ SUBROUTINE Waves_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%InputFile) - OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%DirRoot) - OutData%DirRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%WvKinFile) - OutData%WvKinFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%WriteWvKin = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%UnSum = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%Gravity = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MSL2SWL = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%WvLowCOff = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WvHiCOff = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveDir = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveNDir = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%WaveMultiDir = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%WaveDirMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%WaveDirSpread = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveDirRange = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveDT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%WaveHs = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%WaveModChr) - OutData%WaveModChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%WaveNDAmp = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%WavePhase = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WavePkShp = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%WavePkShpChr) - OutData%WavePkShpChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%InputFile) + OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%DirRoot) + OutData%DirRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%WvKinFile) + OutData%WvKinFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%WriteWvKin = TRANSFER(IntKiBuf(Int_Xferred), OutData%WriteWvKin) + Int_Xferred = Int_Xferred + 1 + OutData%UnSum = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%Gravity = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MSL2SWL = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WvLowCOff = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WvHiCOff = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WaveDir = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WaveNDir = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WaveMultiDir = TRANSFER(IntKiBuf(Int_Xferred), OutData%WaveMultiDir) + Int_Xferred = Int_Xferred + 1 + OutData%WaveDirMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WaveDirSpread = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WaveDirRange = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WaveDT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%WaveHs = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WaveMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%WaveModChr) + OutData%WaveModChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%WaveNDAmp = TRANSFER(IntKiBuf(Int_Xferred), OutData%WaveNDAmp) + Int_Xferred = Int_Xferred + 1 + OutData%WavePhase = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WavePkShp = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(OutData%WavePkShpChr) + OutData%WavePkShpChr(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I i1_l = LBOUND(OutData%WaveSeed,1) i1_u = UBOUND(OutData%WaveSeed,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%WaveSeed = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%WaveSeed))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%WaveSeed) - DEALLOCATE(mask1) - OutData%WaveStMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%WaveTMax = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%WaveTp = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDens = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDpth = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%NWaveElev = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%WaveSeed,1), UBOUND(OutData%WaveSeed,1) + OutData%WaveSeed(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + OutData%WaveStMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WaveTMax = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%WaveTp = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WtrDens = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WtrDpth = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%NWaveElev = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevxi not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -783,15 +792,10 @@ SUBROUTINE Waves_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevxi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveElevxi)>0) OutData%WaveElevxi = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElevxi))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElevxi) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveElevxi,1), UBOUND(OutData%WaveElevxi,1) + OutData%WaveElevxi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevyi not allocated Int_Xferred = Int_Xferred + 1 @@ -806,15 +810,10 @@ SUBROUTINE Waves_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevyi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveElevyi)>0) OutData%WaveElevyi = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElevyi))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElevyi) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveElevyi,1), UBOUND(OutData%WaveElevyi,1) + OutData%WaveElevyi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevXY not allocated Int_Xferred = Int_Xferred + 1 @@ -832,18 +831,15 @@ SUBROUTINE Waves_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevXY.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveElevXY)>0) OutData%WaveElevXY = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElevXY))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElevXY) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveElevXY,2), UBOUND(OutData%WaveElevXY,2) + DO i1 = LBOUND(OutData%WaveElevXY,1), UBOUND(OutData%WaveElevXY,1) + OutData%WaveElevXY(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - OutData%NWaveKin = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NWaveKin = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveKinxi not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -857,15 +853,10 @@ SUBROUTINE Waves_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinxi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveKinxi)>0) OutData%WaveKinxi = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveKinxi))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveKinxi) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveKinxi,1), UBOUND(OutData%WaveKinxi,1) + OutData%WaveKinxi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveKinyi not allocated Int_Xferred = Int_Xferred + 1 @@ -880,15 +871,10 @@ SUBROUTINE Waves_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinyi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveKinyi)>0) OutData%WaveKinyi = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveKinyi))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveKinyi) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveKinyi,1), UBOUND(OutData%WaveKinyi,1) + OutData%WaveKinyi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveKinzi not allocated Int_Xferred = Int_Xferred + 1 @@ -903,15 +889,10 @@ SUBROUTINE Waves_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinzi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveKinzi)>0) OutData%WaveKinzi = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveKinzi))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveKinzi) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveKinzi,1), UBOUND(OutData%WaveKinzi,1) + OutData%WaveKinzi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CurrVxi not allocated Int_Xferred = Int_Xferred + 1 @@ -926,15 +907,10 @@ SUBROUTINE Waves_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CurrVxi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%CurrVxi)>0) OutData%CurrVxi = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CurrVxi))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%CurrVxi) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%CurrVxi,1), UBOUND(OutData%CurrVxi,1) + OutData%CurrVxi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CurrVyi not allocated Int_Xferred = Int_Xferred + 1 @@ -949,20 +925,15 @@ SUBROUTINE Waves_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CurrVyi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%CurrVyi)>0) OutData%CurrVyi = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CurrVyi))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%CurrVyi) - DEALLOCATE(mask1) - END IF - OutData%PCurrVxiPz0 = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%PCurrVyiPz0 = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%CurrVyi,1), UBOUND(OutData%CurrVyi,1) + OutData%CurrVyi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%PCurrVxiPz0 = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%PCurrVyiPz0 = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Waves_UnPackInitInput SUBROUTINE Waves_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -1398,8 +1369,12 @@ SUBROUTINE Waves_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevC0,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElevC0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElevC0))-1 ) = PACK(InData%WaveElevC0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElevC0) + DO i2 = LBOUND(InData%WaveElevC0,2), UBOUND(InData%WaveElevC0,2) + DO i1 = LBOUND(InData%WaveElevC0,1), UBOUND(InData%WaveElevC0,1) + ReKiBuf(Re_Xferred) = InData%WaveElevC0(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveDirArr) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1411,21 +1386,23 @@ SUBROUTINE Waves_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDirArr,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveDirArr)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveDirArr))-1 ) = PACK(InData%WaveDirArr,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveDirArr) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WaveDirMin - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WaveDirMax - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WaveDir - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WaveNDir - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%WaveMultiDir , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WaveDOmega - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%WaveDirArr,1), UBOUND(InData%WaveDirArr,1) + ReKiBuf(Re_Xferred) = InData%WaveDirArr(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%WaveDirMin + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WaveDirMax + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WaveDir + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WaveNDir + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%WaveMultiDir, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WaveDOmega + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WaveKinzi) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1436,8 +1413,10 @@ SUBROUTINE Waves_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveKinzi,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveKinzi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveKinzi))-1 ) = PACK(InData%WaveKinzi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveKinzi) + DO i1 = LBOUND(InData%WaveKinzi,1), UBOUND(InData%WaveKinzi,1) + ReKiBuf(Re_Xferred) = InData%WaveKinzi(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%PWaveDynP0) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1452,8 +1431,12 @@ SUBROUTINE Waves_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveDynP0,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PWaveDynP0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PWaveDynP0))-1 ) = PACK(InData%PWaveDynP0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PWaveDynP0) + DO i2 = LBOUND(InData%PWaveDynP0,2), UBOUND(InData%PWaveDynP0,2) + DO i1 = LBOUND(InData%PWaveDynP0,1), UBOUND(InData%PWaveDynP0,1) + ReKiBuf(Re_Xferred) = InData%PWaveDynP0(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveDynP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1468,8 +1451,12 @@ SUBROUTINE Waves_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveDynP,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveDynP)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveDynP))-1 ) = PACK(InData%WaveDynP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveDynP) + DO i2 = LBOUND(InData%WaveDynP,2), UBOUND(InData%WaveDynP,2) + DO i1 = LBOUND(InData%WaveDynP,1), UBOUND(InData%WaveDynP,1) + ReKiBuf(Re_Xferred) = InData%WaveDynP(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveAcc) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1487,8 +1474,14 @@ SUBROUTINE Waves_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveAcc,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveAcc)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveAcc))-1 ) = PACK(InData%WaveAcc,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveAcc) + DO i3 = LBOUND(InData%WaveAcc,3), UBOUND(InData%WaveAcc,3) + DO i2 = LBOUND(InData%WaveAcc,2), UBOUND(InData%WaveAcc,2) + DO i1 = LBOUND(InData%WaveAcc,1), UBOUND(InData%WaveAcc,1) + ReKiBuf(Re_Xferred) = InData%WaveAcc(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PWaveAcc0) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1506,8 +1499,14 @@ SUBROUTINE Waves_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveAcc0,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PWaveAcc0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PWaveAcc0))-1 ) = PACK(InData%PWaveAcc0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PWaveAcc0) + DO i3 = LBOUND(InData%PWaveAcc0,3), UBOUND(InData%PWaveAcc0,3) + DO i2 = LBOUND(InData%PWaveAcc0,2), UBOUND(InData%PWaveAcc0,2) + DO i1 = LBOUND(InData%PWaveAcc0,1), UBOUND(InData%PWaveAcc0,1) + ReKiBuf(Re_Xferred) = InData%PWaveAcc0(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveVel) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1525,8 +1524,14 @@ SUBROUTINE Waves_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveVel,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveVel)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveVel))-1 ) = PACK(InData%WaveVel,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveVel) + DO i3 = LBOUND(InData%WaveVel,3), UBOUND(InData%WaveVel,3) + DO i2 = LBOUND(InData%WaveVel,2), UBOUND(InData%WaveVel,2) + DO i1 = LBOUND(InData%WaveVel,1), UBOUND(InData%WaveVel,1) + ReKiBuf(Re_Xferred) = InData%WaveVel(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PWaveVel0) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1544,8 +1549,14 @@ SUBROUTINE Waves_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PWaveVel0,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PWaveVel0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PWaveVel0))-1 ) = PACK(InData%PWaveVel0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PWaveVel0) + DO i3 = LBOUND(InData%PWaveVel0,3), UBOUND(InData%PWaveVel0,3) + DO i2 = LBOUND(InData%PWaveVel0,2), UBOUND(InData%PWaveVel0,2) + DO i1 = LBOUND(InData%PWaveVel0,1), UBOUND(InData%PWaveVel0,1) + ReKiBuf(Re_Xferred) = InData%PWaveVel0(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveElev) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1560,8 +1571,12 @@ SUBROUTINE Waves_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElev)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElev))-1 ) = PACK(InData%WaveElev,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElev) + DO i2 = LBOUND(InData%WaveElev,2), UBOUND(InData%WaveElev,2) + DO i1 = LBOUND(InData%WaveElev,1), UBOUND(InData%WaveElev,1) + ReKiBuf(Re_Xferred) = InData%WaveElev(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveElev0) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1573,8 +1588,10 @@ SUBROUTINE Waves_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev0,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElev0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElev0))-1 ) = PACK(InData%WaveElev0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElev0) + DO i1 = LBOUND(InData%WaveElev0,1), UBOUND(InData%WaveElev0,1) + ReKiBuf(Re_Xferred) = InData%WaveElev0(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveElevSeries) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1589,8 +1606,12 @@ SUBROUTINE Waves_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevSeries,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElevSeries)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElevSeries))-1 ) = PACK(InData%WaveElevSeries,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElevSeries) + DO i2 = LBOUND(InData%WaveElevSeries,2), UBOUND(InData%WaveElevSeries,2) + DO i1 = LBOUND(InData%WaveElevSeries,1), UBOUND(InData%WaveElevSeries,1) + ReKiBuf(Re_Xferred) = InData%WaveElevSeries(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveTime) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1602,11 +1623,13 @@ SUBROUTINE Waves_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveTime,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveTime)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveTime))-1 ) = PACK(InData%WaveTime,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveTime) + DO i1 = LBOUND(InData%WaveTime,1), UBOUND(InData%WaveTime,1) + ReKiBuf(Re_Xferred) = InData%WaveTime(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%WaveTMax - Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%WaveTMax + Db_Xferred = Db_Xferred + 1 IF ( .NOT. ALLOCATED(InData%nodeInWater) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1620,15 +1643,19 @@ SUBROUTINE Waves_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%nodeInWater,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%nodeInWater)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%nodeInWater))-1 ) = PACK(InData%nodeInWater,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%nodeInWater) + DO i2 = LBOUND(InData%nodeInWater,2), UBOUND(InData%nodeInWater,2) + DO i1 = LBOUND(InData%nodeInWater,1), UBOUND(InData%nodeInWater,1) + IntKiBuf(Int_Xferred) = InData%nodeInWater(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RhoXg - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NStepWave2 - Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RhoXg + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepWave + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepWave2 + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Waves_PackInitOutput SUBROUTINE Waves_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1644,12 +1671,6 @@ SUBROUTINE Waves_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (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 @@ -1682,15 +1703,12 @@ SUBROUTINE Waves_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevC0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveElevC0)>0) OutData%WaveElevC0 = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElevC0))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElevC0) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveElevC0,2), UBOUND(OutData%WaveElevC0,2) + DO i1 = LBOUND(OutData%WaveElevC0,1), UBOUND(OutData%WaveElevC0,1) + OutData%WaveElevC0(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDirArr not allocated Int_Xferred = Int_Xferred + 1 @@ -1705,28 +1723,23 @@ SUBROUTINE Waves_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDirArr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveDirArr)>0) OutData%WaveDirArr = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveDirArr))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveDirArr) - DEALLOCATE(mask1) - END IF - OutData%WaveDirMin = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveDirMax = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveDir = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%WaveNDir = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%WaveMultiDir = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%WaveDOmega = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%WaveDirArr,1), UBOUND(OutData%WaveDirArr,1) + OutData%WaveDirArr(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%WaveDirMin = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WaveDirMax = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WaveDir = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%WaveNDir = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WaveMultiDir = TRANSFER(IntKiBuf(Int_Xferred), OutData%WaveMultiDir) + Int_Xferred = Int_Xferred + 1 + OutData%WaveDOmega = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveKinzi not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1740,15 +1753,10 @@ SUBROUTINE Waves_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveKinzi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveKinzi)>0) OutData%WaveKinzi = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveKinzi))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveKinzi) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveKinzi,1), UBOUND(OutData%WaveKinzi,1) + OutData%WaveKinzi(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PWaveDynP0 not allocated Int_Xferred = Int_Xferred + 1 @@ -1766,15 +1774,12 @@ SUBROUTINE Waves_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveDynP0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PWaveDynP0)>0) OutData%PWaveDynP0 = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PWaveDynP0))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%PWaveDynP0) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PWaveDynP0,2), UBOUND(OutData%PWaveDynP0,2) + DO i1 = LBOUND(OutData%PWaveDynP0,1), UBOUND(OutData%PWaveDynP0,1) + OutData%PWaveDynP0(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveDynP not allocated Int_Xferred = Int_Xferred + 1 @@ -1792,15 +1797,12 @@ SUBROUTINE Waves_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveDynP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveDynP)>0) OutData%WaveDynP = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveDynP))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveDynP) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveDynP,2), UBOUND(OutData%WaveDynP,2) + DO i1 = LBOUND(OutData%WaveDynP,1), UBOUND(OutData%WaveDynP,1) + OutData%WaveDynP(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveAcc not allocated Int_Xferred = Int_Xferred + 1 @@ -1821,15 +1823,14 @@ SUBROUTINE Waves_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveAcc.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%WaveAcc)>0) OutData%WaveAcc = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveAcc))-1 ), mask3, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveAcc) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%WaveAcc,3), UBOUND(OutData%WaveAcc,3) + DO i2 = LBOUND(OutData%WaveAcc,2), UBOUND(OutData%WaveAcc,2) + DO i1 = LBOUND(OutData%WaveAcc,1), UBOUND(OutData%WaveAcc,1) + OutData%WaveAcc(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PWaveAcc0 not allocated Int_Xferred = Int_Xferred + 1 @@ -1850,15 +1851,14 @@ SUBROUTINE Waves_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveAcc0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PWaveAcc0)>0) OutData%PWaveAcc0 = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PWaveAcc0))-1 ), mask3, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%PWaveAcc0) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PWaveAcc0,3), UBOUND(OutData%PWaveAcc0,3) + DO i2 = LBOUND(OutData%PWaveAcc0,2), UBOUND(OutData%PWaveAcc0,2) + DO i1 = LBOUND(OutData%PWaveAcc0,1), UBOUND(OutData%PWaveAcc0,1) + OutData%PWaveAcc0(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveVel not allocated Int_Xferred = Int_Xferred + 1 @@ -1879,15 +1879,14 @@ SUBROUTINE Waves_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveVel.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%WaveVel)>0) OutData%WaveVel = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveVel))-1 ), mask3, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveVel) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%WaveVel,3), UBOUND(OutData%WaveVel,3) + DO i2 = LBOUND(OutData%WaveVel,2), UBOUND(OutData%WaveVel,2) + DO i1 = LBOUND(OutData%WaveVel,1), UBOUND(OutData%WaveVel,1) + OutData%WaveVel(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PWaveVel0 not allocated Int_Xferred = Int_Xferred + 1 @@ -1908,15 +1907,14 @@ SUBROUTINE Waves_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PWaveVel0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%PWaveVel0)>0) OutData%PWaveVel0 = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PWaveVel0))-1 ), mask3, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%PWaveVel0) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%PWaveVel0,3), UBOUND(OutData%PWaveVel0,3) + DO i2 = LBOUND(OutData%PWaveVel0,2), UBOUND(OutData%PWaveVel0,2) + DO i1 = LBOUND(OutData%PWaveVel0,1), UBOUND(OutData%PWaveVel0,1) + OutData%PWaveVel0(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev not allocated Int_Xferred = Int_Xferred + 1 @@ -1934,15 +1932,12 @@ SUBROUTINE Waves_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveElev)>0) OutData%WaveElev = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElev))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElev) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveElev,2), UBOUND(OutData%WaveElev,2) + DO i1 = LBOUND(OutData%WaveElev,1), UBOUND(OutData%WaveElev,1) + OutData%WaveElev(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev0 not allocated Int_Xferred = Int_Xferred + 1 @@ -1957,15 +1952,10 @@ SUBROUTINE Waves_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveElev0)>0) OutData%WaveElev0 = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElev0))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElev0) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveElev0,1), UBOUND(OutData%WaveElev0,1) + OutData%WaveElev0(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevSeries not allocated Int_Xferred = Int_Xferred + 1 @@ -1983,15 +1973,12 @@ SUBROUTINE Waves_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevSeries.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveElevSeries)>0) OutData%WaveElevSeries = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElevSeries))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElevSeries) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveElevSeries,2), UBOUND(OutData%WaveElevSeries,2) + DO i1 = LBOUND(OutData%WaveElevSeries,1), UBOUND(OutData%WaveElevSeries,1) + OutData%WaveElevSeries(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveTime not allocated Int_Xferred = Int_Xferred + 1 @@ -2006,18 +1993,13 @@ SUBROUTINE Waves_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveTime.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WaveTime)>0) OutData%WaveTime = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveTime))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveTime) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WaveTime,1), UBOUND(OutData%WaveTime,1) + OutData%WaveTime(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%WaveTMax = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%WaveTMax = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! nodeInWater not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -2034,22 +2016,19 @@ SUBROUTINE Waves_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%nodeInWater.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%nodeInWater)>0) OutData%nodeInWater = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%nodeInWater))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%nodeInWater) - DEALLOCATE(mask2) - END IF - OutData%RhoXg = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%NStepWave = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NStepWave2 = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(OutData%nodeInWater,2), UBOUND(OutData%nodeInWater,2) + DO i1 = LBOUND(OutData%nodeInWater,1), UBOUND(OutData%nodeInWater,1) + OutData%nodeInWater(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + OutData%RhoXg = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%NStepWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NStepWave2 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Waves_UnPackInitOutput SUBROUTINE Waves_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) @@ -2143,8 +2122,8 @@ SUBROUTINE Waves_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyContState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyContState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Waves_PackContState SUBROUTINE Waves_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2160,12 +2139,6 @@ SUBROUTINE Waves_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Waves_UnPackContState' @@ -2179,8 +2152,8 @@ SUBROUTINE Waves_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyContState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyContState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Waves_UnPackContState SUBROUTINE Waves_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) @@ -2274,8 +2247,8 @@ SUBROUTINE Waves_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyDiscState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyDiscState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Waves_PackDiscState SUBROUTINE Waves_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2291,12 +2264,6 @@ SUBROUTINE Waves_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Waves_UnPackDiscState' @@ -2310,8 +2277,8 @@ SUBROUTINE Waves_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyDiscState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyDiscState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Waves_UnPackDiscState SUBROUTINE Waves_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) @@ -2405,8 +2372,8 @@ SUBROUTINE Waves_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyConstrState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Waves_PackConstrState SUBROUTINE Waves_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2422,12 +2389,6 @@ SUBROUTINE Waves_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Waves_UnPackConstrState' @@ -2441,8 +2402,8 @@ SUBROUTINE Waves_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyConstrState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyConstrState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Waves_UnPackConstrState SUBROUTINE Waves_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -2536,8 +2497,8 @@ SUBROUTINE Waves_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DummyOtherState - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DummyOtherState + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Waves_PackOtherState SUBROUTINE Waves_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2553,12 +2514,6 @@ SUBROUTINE Waves_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Waves_UnPackOtherState' @@ -2572,8 +2527,8 @@ SUBROUTINE Waves_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyOtherState = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%DummyOtherState = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Waves_UnPackOtherState SUBROUTINE Waves_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) @@ -2667,8 +2622,8 @@ SUBROUTINE Waves_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DummyMiscVar - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DummyMiscVar + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Waves_PackMisc SUBROUTINE Waves_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2684,12 +2639,6 @@ SUBROUTINE Waves_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Waves_UnPackMisc' @@ -2703,8 +2652,8 @@ SUBROUTINE Waves_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyMiscVar = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%DummyMiscVar = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Waves_UnPackMisc SUBROUTINE Waves_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -2806,16 +2755,16 @@ SUBROUTINE Waves_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%WaveTMax - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NStepWave - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WaveNDir - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%WaveMultiDir , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%WaveTMax + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NStepWave + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WaveNDir + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%WaveMultiDir, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Waves_PackParam SUBROUTINE Waves_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2831,12 +2780,6 @@ SUBROUTINE Waves_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Waves_UnPackParam' @@ -2850,16 +2793,16 @@ SUBROUTINE Waves_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%WaveTMax = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%NStepWave = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%WaveNDir = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%WaveMultiDir = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%WaveTMax = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%NStepWave = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WaveNDir = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WaveMultiDir = TRANSFER(IntKiBuf(Int_Xferred), OutData%WaveMultiDir) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Waves_UnPackParam SUBROUTINE Waves_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -2953,8 +2896,8 @@ SUBROUTINE Waves_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyInput - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyInput + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Waves_PackInput SUBROUTINE Waves_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2970,12 +2913,6 @@ SUBROUTINE Waves_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Waves_UnPackInput' @@ -2989,8 +2926,8 @@ SUBROUTINE Waves_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyInput = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyInput = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Waves_UnPackInput SUBROUTINE Waves_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -3084,8 +3021,8 @@ SUBROUTINE Waves_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyOutput - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyOutput + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Waves_PackOutput SUBROUTINE Waves_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -3101,12 +3038,6 @@ SUBROUTINE Waves_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Waves_UnPackOutput' @@ -3120,8 +3051,8 @@ SUBROUTINE Waves_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyOutput = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyOutput = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Waves_UnPackOutput @@ -3199,8 +3130,8 @@ SUBROUTINE Waves_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMs REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'Waves_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -3215,8 +3146,10 @@ SUBROUTINE Waves_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - b0 = -(u1%DummyInput - u2%DummyInput)/t(2) - u_out%DummyInput = u1%DummyInput + b0 * t_out + + ScaleFactor = t_out / t(2) + b = -(u1%DummyInput - u2%DummyInput) + u_out%DummyInput = u1%DummyInput + b * ScaleFactor END SUBROUTINE Waves_Input_ExtrapInterp1 @@ -3246,8 +3179,9 @@ SUBROUTINE Waves_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, E REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'Waves_Input_ExtrapInterp2' @@ -3269,9 +3203,11 @@ SUBROUTINE Waves_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, E CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - b0 = (t(3)**2*(u1%DummyInput - u2%DummyInput) + t(2)**2*(-u1%DummyInput + u3%DummyInput))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%DummyInput + t(3)*u2%DummyInput - t(2)*u3%DummyInput ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%DummyInput = u1%DummyInput + b0 * t_out + c0 * t_out**2 + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) + b = (t(3)**2*(u1%DummyInput - u2%DummyInput) + t(2)**2*(-u1%DummyInput + u3%DummyInput))* scaleFactor + c = ( (t(2)-t(3))*u1%DummyInput + t(3)*u2%DummyInput - t(2)*u3%DummyInput ) * scaleFactor + u_out%DummyInput = u1%DummyInput + b + c * t_out END SUBROUTINE Waves_Input_ExtrapInterp2 @@ -3349,8 +3285,8 @@ SUBROUTINE Waves_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrM REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'Waves_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -3365,8 +3301,10 @@ SUBROUTINE Waves_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - b0 = -(y1%DummyOutput - y2%DummyOutput)/t(2) - y_out%DummyOutput = y1%DummyOutput + b0 * t_out + + ScaleFactor = t_out / t(2) + b = -(y1%DummyOutput - y2%DummyOutput) + y_out%DummyOutput = y1%DummyOutput + b * ScaleFactor END SUBROUTINE Waves_Output_ExtrapInterp1 @@ -3396,8 +3334,9 @@ SUBROUTINE Waves_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'Waves_Output_ExtrapInterp2' @@ -3419,9 +3358,11 @@ SUBROUTINE Waves_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - b0 = (t(3)**2*(y1%DummyOutput - y2%DummyOutput) + t(2)**2*(-y1%DummyOutput + y3%DummyOutput))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%DummyOutput + t(3)*y2%DummyOutput - t(2)*y3%DummyOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%DummyOutput = y1%DummyOutput + b0 * t_out + c0 * t_out**2 + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) + b = (t(3)**2*(y1%DummyOutput - y2%DummyOutput) + t(2)**2*(-y1%DummyOutput + y3%DummyOutput))* scaleFactor + c = ( (t(2)-t(3))*y1%DummyOutput + t(3)*y2%DummyOutput - t(2)*y3%DummyOutput ) * scaleFactor + y_out%DummyOutput = y1%DummyOutput + b + c * t_out END SUBROUTINE Waves_Output_ExtrapInterp2 END MODULE Waves_Types diff --git a/modules/icedyn/src/IceDyn_Types.f90 b/modules/icedyn/src/IceDyn_Types.f90 index cdc9cf05c0..5a676fa8b3 100644 --- a/modules/icedyn/src/IceDyn_Types.f90 +++ b/modules/icedyn/src/IceDyn_Types.f90 @@ -489,28 +489,28 @@ SUBROUTINE IceD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%IceModel - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%IceSubModel - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%h - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%v - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%InitLoc - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%t0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rhow - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rhoi - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Seed1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Seed2 - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumLegs - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%IceModel + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%IceSubModel + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%h + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%v + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%InitLoc + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%t0 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rhow + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rhoi + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Seed1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Seed2 + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumLegs + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%LegPosX) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -521,8 +521,10 @@ SUBROUTINE IceD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LegPosX,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LegPosX)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LegPosX))-1 ) = PACK(InData%LegPosX,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LegPosX) + DO i1 = LBOUND(InData%LegPosX,1), UBOUND(InData%LegPosX,1) + ReKiBuf(Re_Xferred) = InData%LegPosX(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LegPosY) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -534,8 +536,10 @@ SUBROUTINE IceD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LegPosY,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LegPosY)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LegPosY))-1 ) = PACK(InData%LegPosY,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LegPosY) + DO i1 = LBOUND(InData%LegPosY,1), UBOUND(InData%LegPosY,1) + ReKiBuf(Re_Xferred) = InData%LegPosY(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%StrWd) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -547,101 +551,103 @@ SUBROUTINE IceD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StrWd,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%StrWd)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%StrWd))-1 ) = PACK(InData%StrWd,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%StrWd) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Ikm - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Ag - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Qg - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Rg - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Tice - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%nu - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%phi - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SigNm - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Eice - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%IceStr2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Delmax2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Pitch - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%miuh - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%varh - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%miuv - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%varv - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%miut - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%miubr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%varbr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%miuDelm - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%varDelm - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%miuP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%varP - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Zn1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Zn2 - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ZonePitch - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PrflMean - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PrflSig - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%IceStr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Delmax - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%alpha - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Dwl - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Dtp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%hr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%mu - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%sigf - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%StrLim - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%StrRtLim - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UorD - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Ll - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Lw - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cpa - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dpa - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Fdr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Kic - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%FspN - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%StrWd,1), UBOUND(InData%StrWd,1) + ReKiBuf(Re_Xferred) = InData%StrWd(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%Ikm + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Ag + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Qg + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Rg + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Tice + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%nu + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%phi + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SigNm + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Eice + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%IceStr2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Delmax2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Pitch + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%miuh + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%varh + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%miuv + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%varv + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%miut + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%miubr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%varbr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%miuDelm + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%varDelm + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%miuP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%varP + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Zn1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Zn2 + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%ZonePitch + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PrflMean + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PrflSig + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%IceStr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Delmax + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%alpha + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Dwl + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Dtp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%hr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%mu + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%sigf + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%StrLim + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%StrRtLim + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%UorD + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Ll + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Lw + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cpa + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%dpa + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Fdr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Kic + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FspN + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IceD_PackInputFile SUBROUTINE IceD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -657,12 +663,6 @@ SUBROUTINE IceD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -677,28 +677,28 @@ SUBROUTINE IceD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%IceModel = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%IceSubModel = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%h = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%v = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%InitLoc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%t0 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rhow = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rhoi = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Seed1 = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%Seed2 = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumLegs = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%IceModel = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%IceSubModel = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%h = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%v = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%InitLoc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%t0 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rhow = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rhoi = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Seed1 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%Seed2 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumLegs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LegPosX not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -712,15 +712,10 @@ SUBROUTINE IceD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LegPosX.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LegPosX)>0) OutData%LegPosX = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LegPosX))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LegPosX) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LegPosX,1), UBOUND(OutData%LegPosX,1) + OutData%LegPosX(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LegPosY not allocated Int_Xferred = Int_Xferred + 1 @@ -735,15 +730,10 @@ SUBROUTINE IceD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LegPosY.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LegPosY)>0) OutData%LegPosY = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LegPosY))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LegPosY) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LegPosY,1), UBOUND(OutData%LegPosY,1) + OutData%LegPosY(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StrWd not allocated Int_Xferred = Int_Xferred + 1 @@ -758,108 +748,103 @@ SUBROUTINE IceD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StrWd.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%StrWd)>0) OutData%StrWd = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%StrWd))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%StrWd) - DEALLOCATE(mask1) - END IF - OutData%Ikm = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Ag = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Qg = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Rg = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Tice = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%nu = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%phi = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SigNm = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Eice = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%IceStr2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Delmax2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Pitch = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%miuh = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%varh = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%miuv = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%varv = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%miut = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%miubr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%varbr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%miuDelm = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%varDelm = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%miuP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%varP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Zn1 = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%Zn2 = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%ZonePitch = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PrflMean = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PrflSig = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%IceStr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Delmax = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%alpha = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Dwl = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Dtp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%hr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%mu = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%sigf = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%StrLim = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%StrRtLim = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%UorD = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%Ll = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Lw = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cpa = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%dpa = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Fdr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Kic = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%FspN = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%StrWd,1), UBOUND(OutData%StrWd,1) + OutData%StrWd(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%Ikm = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Ag = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Qg = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Rg = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Tice = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%nu = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%phi = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SigNm = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Eice = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%IceStr2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Delmax2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Pitch = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%miuh = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%varh = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%miuv = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%varv = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%miut = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%miubr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%varbr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%miuDelm = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%varDelm = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%miuP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%varP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Zn1 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%Zn2 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ZonePitch = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PrflMean = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PrflSig = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%IceStr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Delmax = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%alpha = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Dwl = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Dtp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%hr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%mu = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%sigf = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%StrLim = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%StrRtLim = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%UorD = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%Ll = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Lw = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cpa = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%dpa = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Fdr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Kic = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%FspN = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IceD_UnPackInputFile SUBROUTINE IceD_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) @@ -965,24 +950,24 @@ SUBROUTINE IceD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MSL2SWL - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WtrDens - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%gravity - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%LegNum - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%TMax - Db_Xferred = Db_Xferred + 1 + DO I = 1, LEN(InData%InputFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + ReKiBuf(Re_Xferred) = InData%MSL2SWL + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDens + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%gravity + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%LegNum + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%TMax + Db_Xferred = Db_Xferred + 1 END SUBROUTINE IceD_PackInitInput SUBROUTINE IceD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -998,12 +983,6 @@ SUBROUTINE IceD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IceD_UnPackInitInput' @@ -1017,24 +996,24 @@ SUBROUTINE IceD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%InputFile) - OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%MSL2SWL = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%gravity = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%LegNum = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TMax = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + DO I = 1, LEN(OutData%InputFile) + OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%MSL2SWL = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WtrDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%gravity = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LegNum = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TMax = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 END SUBROUTINE IceD_UnPackInitInput SUBROUTINE IceD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -1201,12 +1180,12 @@ SUBROUTINE IceD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1218,15 +1197,15 @@ SUBROUTINE IceD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%numLegs - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%numLegs + Int_Xferred = Int_Xferred + 1 CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Ver, ErrStat2, ErrMsg2, OnlySize ) ! Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1270,12 +1249,6 @@ SUBROUTINE IceD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1303,19 +1276,12 @@ SUBROUTINE IceD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated Int_Xferred = Int_Xferred + 1 @@ -1330,22 +1296,15 @@ SUBROUTINE IceD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF - OutData%numLegs = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%numLegs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -1481,10 +1440,10 @@ SUBROUTINE IceD_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%q - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dqdt - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%q + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%dqdt + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IceD_PackContState SUBROUTINE IceD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1500,12 +1459,6 @@ SUBROUTINE IceD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IceD_UnPackContState' @@ -1519,10 +1472,10 @@ SUBROUTINE IceD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%q = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%dqdt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%q = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%dqdt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IceD_UnPackContState SUBROUTINE IceD_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) @@ -1616,8 +1569,8 @@ SUBROUTINE IceD_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyDiscState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyDiscState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IceD_PackDiscState SUBROUTINE IceD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1633,12 +1586,6 @@ SUBROUTINE IceD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IceD_UnPackDiscState' @@ -1652,8 +1599,8 @@ SUBROUTINE IceD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyDiscState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyDiscState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IceD_UnPackDiscState SUBROUTINE IceD_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) @@ -1747,8 +1694,8 @@ SUBROUTINE IceD_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyConstrState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IceD_PackConstrState SUBROUTINE IceD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1764,12 +1711,6 @@ SUBROUTINE IceD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IceD_UnPackConstrState' @@ -1783,8 +1724,8 @@ SUBROUTINE IceD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyConstrState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyConstrState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IceD_UnPackConstrState SUBROUTINE IceD_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -1995,8 +1936,8 @@ SUBROUTINE IceD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%IceTthNo2 - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%IceTthNo2 + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%Nc) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2007,8 +1948,10 @@ SUBROUTINE IceD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nc,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Nc)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%Nc))-1 ) = PACK(InData%Nc,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%Nc) + DO i1 = LBOUND(InData%Nc,1), UBOUND(InData%Nc,1) + IntKiBuf(Int_Xferred) = InData%Nc(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%Psum) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2020,8 +1963,10 @@ SUBROUTINE IceD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Psum,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Psum)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Psum))-1 ) = PACK(InData%Psum,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Psum) + DO i1 = LBOUND(InData%Psum,1), UBOUND(InData%Psum,1) + ReKiBuf(Re_Xferred) = InData%Psum(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%IceTthNo) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2033,17 +1978,19 @@ SUBROUTINE IceD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IceTthNo,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%IceTthNo)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%IceTthNo))-1 ) = PACK(InData%IceTthNo,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%IceTthNo) + DO i1 = LBOUND(InData%IceTthNo,1), UBOUND(InData%IceTthNo,1) + IntKiBuf(Int_Xferred) = InData%IceTthNo(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Beta - Re_Xferred = Re_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%Tinit - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Splitf - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dxc - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Beta + Re_Xferred = Re_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%Tinit + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Splitf + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%dxc + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%xdot) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2085,8 +2032,8 @@ SUBROUTINE IceD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err ENDIF END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%n - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%n + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IceD_PackOtherState SUBROUTINE IceD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2102,12 +2049,6 @@ SUBROUTINE IceD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -2122,8 +2063,8 @@ SUBROUTINE IceD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%IceTthNo2 = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%IceTthNo2 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Nc not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -2137,15 +2078,10 @@ SUBROUTINE IceD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nc.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Nc)>0) OutData%Nc = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%Nc))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%Nc) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Nc,1), UBOUND(OutData%Nc,1) + OutData%Nc(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Psum not allocated Int_Xferred = Int_Xferred + 1 @@ -2160,15 +2096,10 @@ SUBROUTINE IceD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Psum.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Psum)>0) OutData%Psum = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Psum))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Psum) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Psum,1), UBOUND(OutData%Psum,1) + OutData%Psum(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IceTthNo not allocated Int_Xferred = Int_Xferred + 1 @@ -2183,24 +2114,19 @@ SUBROUTINE IceD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IceTthNo.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%IceTthNo)>0) OutData%IceTthNo = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%IceTthNo))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%IceTthNo) - DEALLOCATE(mask1) - END IF - OutData%Beta = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Tinit = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%Splitf = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%dxc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%IceTthNo,1), UBOUND(OutData%IceTthNo,1) + OutData%IceTthNo(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + OutData%Beta = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Tinit = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%Splitf = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%dxc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xdot not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -2257,8 +2183,8 @@ SUBROUTINE IceD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%n = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%n = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IceD_UnPackOtherState SUBROUTINE IceD_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) @@ -2352,8 +2278,8 @@ SUBROUTINE IceD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DummyMiscVar - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DummyMiscVar + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IceD_PackMisc SUBROUTINE IceD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2369,12 +2295,6 @@ SUBROUTINE IceD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IceD_UnPackMisc' @@ -2388,8 +2308,8 @@ SUBROUTINE IceD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyMiscVar = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%DummyMiscVar = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IceD_UnPackMisc SUBROUTINE IceD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -2778,34 +2698,34 @@ SUBROUTINE IceD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%h - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%v - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%t0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%StrWd - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%InitLoc - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%tolerance - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Tmax - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%verif - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%ModNo - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%SubModNo - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%method - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TmStep - Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%h + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%v + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%t0 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%StrWd + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%dt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%InitLoc + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%tolerance + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Tmax + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%verif + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%ModNo + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%SubModNo + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%method + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TmStep + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%OutName) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2816,12 +2736,12 @@ SUBROUTINE IceD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutName,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%OutName,1), UBOUND(InData%OutName,1) + DO i1 = LBOUND(InData%OutName,1), UBOUND(InData%OutName,1) DO I = 1, LEN(InData%OutName) IntKiBuf(Int_Xferred) = ICHAR(InData%OutName(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%OutUnit) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2833,41 +2753,41 @@ SUBROUTINE IceD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutUnit,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%OutUnit,1), UBOUND(InData%OutUnit,1) + DO i1 = LBOUND(InData%OutUnit,1), UBOUND(InData%OutUnit,1) DO I = 1, LEN(InData%OutUnit) IntKiBuf(Int_Xferred) = ICHAR(InData%OutUnit(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%tm1a - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%tm1b - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%tm1c - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Fmax1a - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Fmax1b - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Fmax1c - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Ikm - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cstr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%EiPa - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Delmax2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Pitch - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Kice2 - Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + ReKiBuf(Re_Xferred) = InData%tm1a + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%tm1b + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%tm1c + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Fmax1a + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Fmax1b + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Fmax1c + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Ikm + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cstr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%EiPa + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Delmax2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Pitch + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Kice2 + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%rdmFm) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2878,8 +2798,10 @@ SUBROUTINE IceD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rdmFm,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%rdmFm)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%rdmFm))-1 ) = PACK(InData%rdmFm,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%rdmFm) + DO i1 = LBOUND(InData%rdmFm,1), UBOUND(InData%rdmFm,1) + ReKiBuf(Re_Xferred) = InData%rdmFm(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%rdmt0) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2891,8 +2813,10 @@ SUBROUTINE IceD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rdmt0,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%rdmt0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%rdmt0))-1 ) = PACK(InData%rdmt0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%rdmt0) + DO i1 = LBOUND(InData%rdmt0,1), UBOUND(InData%rdmt0,1) + ReKiBuf(Re_Xferred) = InData%rdmt0(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%rdmtm) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2904,8 +2828,10 @@ SUBROUTINE IceD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rdmtm,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%rdmtm)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%rdmtm))-1 ) = PACK(InData%rdmtm,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%rdmtm) + DO i1 = LBOUND(InData%rdmtm,1), UBOUND(InData%rdmtm,1) + ReKiBuf(Re_Xferred) = InData%rdmtm(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%rdmDm) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2917,8 +2843,10 @@ SUBROUTINE IceD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rdmDm,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%rdmDm)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%rdmDm))-1 ) = PACK(InData%rdmDm,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%rdmDm) + DO i1 = LBOUND(InData%rdmDm,1), UBOUND(InData%rdmDm,1) + ReKiBuf(Re_Xferred) = InData%rdmDm(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%rdmP) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2930,8 +2858,10 @@ SUBROUTINE IceD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rdmP,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%rdmP)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%rdmP))-1 ) = PACK(InData%rdmP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%rdmP) + DO i1 = LBOUND(InData%rdmP,1), UBOUND(InData%rdmP,1) + ReKiBuf(Re_Xferred) = InData%rdmP(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%rdmKi) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2943,15 +2873,17 @@ SUBROUTINE IceD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rdmKi,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%rdmKi)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%rdmKi))-1 ) = PACK(InData%rdmKi,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%rdmKi) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ZonePitch - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Kice - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Delmax - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%rdmKi,1), UBOUND(InData%rdmKi,1) + ReKiBuf(Re_Xferred) = InData%rdmKi(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%ZonePitch + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Kice + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Delmax + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%Y0) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2962,8 +2894,10 @@ SUBROUTINE IceD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Y0,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Y0)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Y0))-1 ) = PACK(InData%Y0,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Y0) + DO i1 = LBOUND(InData%Y0,1), UBOUND(InData%Y0,1) + ReKiBuf(Re_Xferred) = InData%Y0(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%ContPrfl) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2975,45 +2909,47 @@ SUBROUTINE IceD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ContPrfl,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ContPrfl)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%ContPrfl))-1 ) = PACK(InData%ContPrfl,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%ContPrfl) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Zn - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rhoi - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rhow - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%alphaR - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Dwl - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Zr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RHbr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RVbr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Lbr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%LovR - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%mu - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Wri - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WL - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cpa - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dpa - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%FdrN - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Mice - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Fsp - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%ContPrfl,1), UBOUND(InData%ContPrfl,1) + ReKiBuf(Re_Xferred) = InData%ContPrfl(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IntKiBuf(Int_Xferred) = InData%Zn + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rhoi + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rhow + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%alphaR + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Dwl + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Zr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RHbr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RVbr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Lbr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%LovR + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%mu + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Wri + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WL + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cpa + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%dpa + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FdrN + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Mice + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Fsp + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IceD_PackParam SUBROUTINE IceD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -3029,12 +2965,6 @@ SUBROUTINE IceD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -3049,34 +2979,34 @@ SUBROUTINE IceD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%h = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%v = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%t0 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%StrWd = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%dt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%InitLoc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%tolerance = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Tmax = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%verif = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%ModNo = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%SubModNo = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%method = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TmStep = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%h = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%v = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%t0 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%StrWd = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%dt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%InitLoc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%tolerance = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Tmax = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%verif = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ModNo = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%SubModNo = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%method = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TmStep = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutName not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3090,19 +3020,12 @@ SUBROUTINE IceD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutName.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%OutName,1), UBOUND(OutData%OutName,1) + DO i1 = LBOUND(OutData%OutName,1), UBOUND(OutData%OutName,1) DO I = 1, LEN(OutData%OutName) OutData%OutName(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutUnit not allocated Int_Xferred = Int_Xferred + 1 @@ -3117,48 +3040,41 @@ SUBROUTINE IceD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutUnit.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%OutUnit,1), UBOUND(OutData%OutUnit,1) + DO i1 = LBOUND(OutData%OutUnit,1), UBOUND(OutData%OutUnit,1) DO I = 1, LEN(OutData%OutUnit) OutData%OutUnit(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%tm1a = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%tm1b = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%tm1c = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Fmax1a = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Fmax1b = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Fmax1c = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Ikm = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cstr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%EiPa = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Delmax2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Pitch = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Kice2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%tm1a = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%tm1b = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%tm1c = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Fmax1a = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Fmax1b = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Fmax1c = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Ikm = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cstr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%EiPa = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Delmax2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Pitch = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Kice2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rdmFm not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3172,15 +3088,10 @@ SUBROUTINE IceD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rdmFm.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%rdmFm)>0) OutData%rdmFm = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%rdmFm))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%rdmFm) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rdmFm,1), UBOUND(OutData%rdmFm,1) + OutData%rdmFm(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rdmt0 not allocated Int_Xferred = Int_Xferred + 1 @@ -3195,15 +3106,10 @@ SUBROUTINE IceD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rdmt0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%rdmt0)>0) OutData%rdmt0 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%rdmt0))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%rdmt0) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rdmt0,1), UBOUND(OutData%rdmt0,1) + OutData%rdmt0(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rdmtm not allocated Int_Xferred = Int_Xferred + 1 @@ -3218,15 +3124,10 @@ SUBROUTINE IceD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rdmtm.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%rdmtm)>0) OutData%rdmtm = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%rdmtm))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%rdmtm) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rdmtm,1), UBOUND(OutData%rdmtm,1) + OutData%rdmtm(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rdmDm not allocated Int_Xferred = Int_Xferred + 1 @@ -3241,15 +3142,10 @@ SUBROUTINE IceD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rdmDm.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%rdmDm)>0) OutData%rdmDm = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%rdmDm))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%rdmDm) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rdmDm,1), UBOUND(OutData%rdmDm,1) + OutData%rdmDm(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rdmP not allocated Int_Xferred = Int_Xferred + 1 @@ -3264,15 +3160,10 @@ SUBROUTINE IceD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rdmP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%rdmP)>0) OutData%rdmP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%rdmP))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%rdmP) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rdmP,1), UBOUND(OutData%rdmP,1) + OutData%rdmP(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rdmKi not allocated Int_Xferred = Int_Xferred + 1 @@ -3287,22 +3178,17 @@ SUBROUTINE IceD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rdmKi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%rdmKi)>0) OutData%rdmKi = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%rdmKi))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%rdmKi) - DEALLOCATE(mask1) - END IF - OutData%ZonePitch = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Kice = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Delmax = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%rdmKi,1), UBOUND(OutData%rdmKi,1) + OutData%rdmKi(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%ZonePitch = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Kice = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Delmax = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Y0 not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3316,15 +3202,10 @@ SUBROUTINE IceD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Y0.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Y0)>0) OutData%Y0 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Y0))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Y0) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Y0,1), UBOUND(OutData%Y0,1) + OutData%Y0(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ContPrfl not allocated Int_Xferred = Int_Xferred + 1 @@ -3339,52 +3220,47 @@ SUBROUTINE IceD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ContPrfl.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%ContPrfl)>0) OutData%ContPrfl = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%ContPrfl))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%ContPrfl) - DEALLOCATE(mask1) - END IF - OutData%Zn = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%rhoi = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rhow = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%alphaR = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Dwl = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Zr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RHbr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RVbr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Lbr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%LovR = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%mu = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Wri = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%WL = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cpa = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%dpa = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%FdrN = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Mice = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Fsp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%ContPrfl,1), UBOUND(OutData%ContPrfl,1) + OutData%ContPrfl(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%Zn = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%rhoi = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rhow = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%alphaR = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Dwl = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Zr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RHbr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RVbr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Lbr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LovR = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%mu = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Wri = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WL = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cpa = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%dpa = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%FdrN = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Mice = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Fsp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IceD_UnPackParam SUBROUTINE IceD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -3541,12 +3417,6 @@ SUBROUTINE IceD_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IceD_UnPackInput' @@ -3772,8 +3642,10 @@ SUBROUTINE IceD_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WriteOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WriteOutput))-1 ) = PACK(InData%WriteOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WriteOutput) + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE IceD_PackOutput @@ -3790,12 +3662,6 @@ SUBROUTINE IceD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -3863,15 +3729,10 @@ SUBROUTINE IceD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WriteOutput)>0) OutData%WriteOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WriteOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WriteOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE IceD_UnPackOutput @@ -3950,8 +3811,8 @@ SUBROUTINE IceD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'IceD_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -3966,6 +3827,8 @@ SUBROUTINE IceD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(u1%PointMesh, u2%PointMesh, tin, u_out%PointMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE IceD_Input_ExtrapInterp1 @@ -3997,8 +3860,9 @@ SUBROUTINE IceD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'IceD_Input_ExtrapInterp2' @@ -4020,6 +3884,8 @@ SUBROUTINE IceD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(u1%PointMesh, u2%PointMesh, u3%PointMesh, tin, u_out%PointMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE IceD_Input_ExtrapInterp2 @@ -4099,12 +3965,12 @@ SUBROUTINE IceD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'IceD_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -4117,15 +3983,15 @@ SUBROUTINE IceD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(y1%PointMesh, y2%PointMesh, tin, y_out%PointMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = -(y1%WriteOutput - y2%WriteOutput)/t(2) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO END IF ! check if allocated END SUBROUTINE IceD_Output_ExtrapInterp1 @@ -4156,13 +4022,14 @@ SUBROUTINE IceD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'IceD_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -4181,16 +4048,16 @@ SUBROUTINE IceD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(y1%PointMesh, y2%PointMesh, y3%PointMesh, tin, y_out%PointMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = (t(3)**2*(y1%WriteOutput - y2%WriteOutput) + t(2)**2*(-y1%WriteOutput + y3%WriteOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WriteOutput + t(3)*y2%WriteOutput - t(2)*y3%WriteOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO END IF ! check if allocated END SUBROUTINE IceD_Output_ExtrapInterp2 diff --git a/modules/icefloe/src/icefloe/IceFloe_Types.f90 b/modules/icefloe/src/icefloe/IceFloe_Types.f90 index cc860d0a58..630cf872cc 100644 --- a/modules/icefloe/src/icefloe/IceFloe_Types.f90 +++ b/modules/icefloe/src/icefloe/IceFloe_Types.f90 @@ -210,20 +210,20 @@ SUBROUTINE IceFloe_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%simLength - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MSL2SWL - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%gravity - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(InData%InputFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + ReKiBuf(Re_Xferred) = InData%simLength + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MSL2SWL + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%gravity + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE IceFloe_PackInitInput SUBROUTINE IceFloe_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -239,12 +239,6 @@ SUBROUTINE IceFloe_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -260,20 +254,20 @@ SUBROUTINE IceFloe_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%InputFile) - OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%simLength = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MSL2SWL = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%gravity = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%InputFile) + OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%simLength = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MSL2SWL = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%gravity = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE IceFloe_UnPackInitInput SUBROUTINE IceFloe_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -438,12 +432,12 @@ SUBROUTINE IceFloe_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -455,12 +449,12 @@ SUBROUTINE IceFloe_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + 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) @@ -505,12 +499,6 @@ SUBROUTINE IceFloe_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -538,19 +526,12 @@ SUBROUTINE IceFloe_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated Int_Xferred = Int_Xferred + 1 @@ -565,19 +546,12 @@ SUBROUTINE IceFloe_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -712,8 +686,8 @@ SUBROUTINE IceFloe_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyContStateVar - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyContStateVar + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IceFloe_PackContState SUBROUTINE IceFloe_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -729,12 +703,6 @@ SUBROUTINE IceFloe_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_UnPackContState' @@ -748,8 +716,8 @@ SUBROUTINE IceFloe_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyContStateVar = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyContStateVar = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IceFloe_UnPackContState SUBROUTINE IceFloe_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) @@ -843,8 +811,8 @@ SUBROUTINE IceFloe_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyDiscStateVar - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyDiscStateVar + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IceFloe_PackDiscState SUBROUTINE IceFloe_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -860,12 +828,6 @@ SUBROUTINE IceFloe_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_UnPackDiscState' @@ -879,8 +841,8 @@ SUBROUTINE IceFloe_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyDiscStateVar = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyDiscStateVar = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IceFloe_UnPackDiscState SUBROUTINE IceFloe_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) @@ -974,8 +936,8 @@ SUBROUTINE IceFloe_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyConstrStateVar - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyConstrStateVar + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IceFloe_PackConstrState SUBROUTINE IceFloe_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -991,12 +953,6 @@ SUBROUTINE IceFloe_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_UnPackConstrState' @@ -1010,8 +966,8 @@ SUBROUTINE IceFloe_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyConstrStateVar = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyConstrStateVar = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IceFloe_UnPackConstrState SUBROUTINE IceFloe_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -1105,8 +1061,8 @@ SUBROUTINE IceFloe_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DummyOtherState - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DummyOtherState + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IceFloe_PackOtherState SUBROUTINE IceFloe_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1122,12 +1078,6 @@ SUBROUTINE IceFloe_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_UnPackOtherState' @@ -1141,8 +1091,8 @@ SUBROUTINE IceFloe_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyOtherState = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%DummyOtherState = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IceFloe_UnPackOtherState SUBROUTINE IceFloe_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) @@ -1236,8 +1186,8 @@ SUBROUTINE IceFloe_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DummyMiscVar - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DummyMiscVar + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IceFloe_PackMisc SUBROUTINE IceFloe_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1253,12 +1203,6 @@ SUBROUTINE IceFloe_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_UnPackMisc' @@ -1272,8 +1216,8 @@ SUBROUTINE IceFloe_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyMiscVar = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%DummyMiscVar = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IceFloe_UnPackMisc SUBROUTINE IceFloe_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -1492,29 +1436,33 @@ SUBROUTINE IceFloe_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%loadSeries,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%loadSeries)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%loadSeries))-1 ) = PACK(InData%loadSeries,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%loadSeries) + DO i2 = LBOUND(InData%loadSeries,2), UBOUND(InData%loadSeries,2) + DO i1 = LBOUND(InData%loadSeries,1), UBOUND(InData%loadSeries,1) + ReKiBuf(Re_Xferred) = InData%loadSeries(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%iceVel - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%iceDirection - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%minStrength - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%minStrengthNegVel - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%defaultArea - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%crushArea - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%coeffStressRate - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%C(4) - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rampTime - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%iceVel + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%iceDirection + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%minStrength + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%minStrengthNegVel + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%defaultArea + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%crushArea + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%coeffStressRate + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%C(4) + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%dt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rampTime + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%legX) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1525,8 +1473,10 @@ SUBROUTINE IceFloe_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%legX,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%legX)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%legX))-1 ) = PACK(InData%legX,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%legX) + DO i1 = LBOUND(InData%legX,1), UBOUND(InData%legX,1) + ReKiBuf(Re_Xferred) = InData%legX(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%legY) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1538,8 +1488,10 @@ SUBROUTINE IceFloe_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%legY,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%legY)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%legY))-1 ) = PACK(InData%legY,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%legY) + DO i1 = LBOUND(InData%legY,1), UBOUND(InData%legY,1) + ReKiBuf(Re_Xferred) = InData%legY(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%ks) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1551,19 +1503,21 @@ SUBROUTINE IceFloe_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ks,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ks)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%ks))-1 ) = PACK(InData%ks,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%ks) + DO i1 = LBOUND(InData%ks,1), UBOUND(InData%ks,1) + ReKiBuf(Re_Xferred) = InData%ks(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%numLegs - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%iceType - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%logUnitNum - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%singleLoad , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%initFlag , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%numLegs + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%iceType + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%logUnitNum + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%singleLoad, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%initFlag, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IceFloe_PackParam SUBROUTINE IceFloe_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1579,12 +1533,6 @@ SUBROUTINE IceFloe_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -1616,36 +1564,33 @@ SUBROUTINE IceFloe_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%loadSeries.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%loadSeries)>0) OutData%loadSeries = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%loadSeries))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%loadSeries) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%loadSeries,2), UBOUND(OutData%loadSeries,2) + DO i1 = LBOUND(OutData%loadSeries,1), UBOUND(OutData%loadSeries,1) + OutData%loadSeries(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - OutData%iceVel = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%iceDirection = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%minStrength = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%minStrengthNegVel = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%defaultArea = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%crushArea = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%coeffStressRate = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%C(4) = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%dt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rampTime = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%iceVel = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%iceDirection = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%minStrength = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%minStrengthNegVel = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%defaultArea = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%crushArea = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%coeffStressRate = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%C(4) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%dt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rampTime = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! legX not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1659,15 +1604,10 @@ SUBROUTINE IceFloe_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%legX.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%legX)>0) OutData%legX = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%legX))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%legX) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%legX,1), UBOUND(OutData%legX,1) + OutData%legX(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! legY not allocated Int_Xferred = Int_Xferred + 1 @@ -1682,15 +1622,10 @@ SUBROUTINE IceFloe_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%legY.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%legY)>0) OutData%legY = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%legY))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%legY) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%legY,1), UBOUND(OutData%legY,1) + OutData%legY(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ks not allocated Int_Xferred = Int_Xferred + 1 @@ -1705,26 +1640,21 @@ SUBROUTINE IceFloe_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ks.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%ks)>0) OutData%ks = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%ks))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%ks) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%ks,1), UBOUND(OutData%ks,1) + OutData%ks(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%numLegs = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%iceType = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%logUnitNum = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%singleLoad = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%initFlag = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%numLegs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%iceType = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%logUnitNum = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%singleLoad = TRANSFER(IntKiBuf(Int_Xferred), OutData%singleLoad) + Int_Xferred = Int_Xferred + 1 + OutData%initFlag = TRANSFER(IntKiBuf(Int_Xferred), OutData%initFlag) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IceFloe_UnPackParam SUBROUTINE IceFloe_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -1881,12 +1811,6 @@ SUBROUTINE IceFloe_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_UnPackInput' @@ -2112,8 +2036,10 @@ SUBROUTINE IceFloe_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WriteOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WriteOutput))-1 ) = PACK(InData%WriteOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WriteOutput) + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE IceFloe_PackOutput @@ -2130,12 +2056,6 @@ SUBROUTINE IceFloe_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -2203,15 +2123,10 @@ SUBROUTINE IceFloe_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WriteOutput)>0) OutData%WriteOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WriteOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WriteOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE IceFloe_UnPackOutput @@ -2290,8 +2205,8 @@ SUBROUTINE IceFloe_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, Err REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -2306,6 +2221,8 @@ SUBROUTINE IceFloe_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(u1%iceMesh, u2%iceMesh, tin, u_out%iceMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE IceFloe_Input_ExtrapInterp1 @@ -2337,8 +2254,9 @@ SUBROUTINE IceFloe_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_Input_ExtrapInterp2' @@ -2360,6 +2278,8 @@ SUBROUTINE IceFloe_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(u1%iceMesh, u2%iceMesh, u3%iceMesh, tin, u_out%iceMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE IceFloe_Input_ExtrapInterp2 @@ -2439,12 +2359,12 @@ SUBROUTINE IceFloe_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, Er REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -2457,15 +2377,15 @@ SUBROUTINE IceFloe_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(y1%iceMesh, y2%iceMesh, tin, y_out%iceMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = -(y1%WriteOutput - y2%WriteOutput)/t(2) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO END IF ! check if allocated END SUBROUTINE IceFloe_Output_ExtrapInterp1 @@ -2496,13 +2416,14 @@ SUBROUTINE IceFloe_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'IceFloe_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -2521,16 +2442,16 @@ SUBROUTINE IceFloe_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(y1%iceMesh, y2%iceMesh, y3%iceMesh, tin, y_out%iceMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = (t(3)**2*(y1%WriteOutput - y2%WriteOutput) + t(2)**2*(-y1%WriteOutput + y3%WriteOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WriteOutput + t(3)*y2%WriteOutput - t(2)*y3%WriteOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO END IF ! check if allocated END SUBROUTINE IceFloe_Output_ExtrapInterp2 diff --git a/modules/inflowwind/src/IfW_4Dext_Types.f90 b/modules/inflowwind/src/IfW_4Dext_Types.f90 index f34008bcb5..b87a4e1fe4 100644 --- a/modules/inflowwind/src/IfW_4Dext_Types.f90 +++ b/modules/inflowwind/src/IfW_4Dext_Types.f90 @@ -159,12 +159,18 @@ SUBROUTINE IfW_4Dext_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%n))-1 ) = PACK(InData%n,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%n) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%delta))-1 ) = PACK(InData%delta,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%delta) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%pZero))-1 ) = PACK(InData%pZero,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%pZero) + DO i1 = LBOUND(InData%n,1), UBOUND(InData%n,1) + IntKiBuf(Int_Xferred) = InData%n(i1) + Int_Xferred = Int_Xferred + 1 + END DO + DO i1 = LBOUND(InData%delta,1), UBOUND(InData%delta,1) + ReKiBuf(Re_Xferred) = InData%delta(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%pZero,1), UBOUND(InData%pZero,1) + ReKiBuf(Re_Xferred) = InData%pZero(i1) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE IfW_4Dext_PackInitInput SUBROUTINE IfW_4Dext_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -180,12 +186,6 @@ SUBROUTINE IfW_4Dext_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (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 @@ -206,37 +206,22 @@ SUBROUTINE IfW_4Dext_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Int_Xferred = 1 i1_l = LBOUND(OutData%n,1) i1_u = UBOUND(OutData%n,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%n = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%n))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%n) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%n,1), UBOUND(OutData%n,1) + OutData%n(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO i1_l = LBOUND(OutData%delta,1) i1_u = UBOUND(OutData%delta,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%delta = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%delta))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%delta) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%delta,1), UBOUND(OutData%delta,1) + OutData%delta(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%pZero,1) i1_u = UBOUND(OutData%pZero,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%pZero = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%pZero))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%pZero) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%pZero,1), UBOUND(OutData%pZero,1) + OutData%pZero(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE IfW_4Dext_UnPackInitInput SUBROUTINE IfW_4Dext_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -393,12 +378,6 @@ SUBROUTINE IfW_4Dext_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IfW_4Dext_UnPackInitOutput' @@ -600,11 +579,21 @@ SUBROUTINE IfW_4Dext_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%V,5) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%V)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%V))-1 ) = PACK(InData%V,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%V) + DO i5 = LBOUND(InData%V,5), UBOUND(InData%V,5) + DO i4 = LBOUND(InData%V,4), UBOUND(InData%V,4) + DO i3 = LBOUND(InData%V,3), UBOUND(InData%V,3) + DO i2 = LBOUND(InData%V,2), UBOUND(InData%V,2) + DO i1 = LBOUND(InData%V,1), UBOUND(InData%V,1) + ReKiBuf(Re_Xferred) = InData%V(i1,i2,i3,i4,i5) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TgridStart - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TgridStart + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IfW_4Dext_PackMisc SUBROUTINE IfW_4Dext_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -620,12 +609,6 @@ SUBROUTINE IfW_4Dext_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (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 @@ -669,18 +652,21 @@ SUBROUTINE IfW_4Dext_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%V.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask5(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u,i4_l:i4_u,i5_l:i5_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask5.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask5 = .TRUE. - IF (SIZE(OutData%V)>0) OutData%V = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%V))-1 ), mask5, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%V) - DEALLOCATE(mask5) + DO i5 = LBOUND(OutData%V,5), UBOUND(OutData%V,5) + DO i4 = LBOUND(OutData%V,4), UBOUND(OutData%V,4) + DO i3 = LBOUND(OutData%V,3), UBOUND(OutData%V,3) + DO i2 = LBOUND(OutData%V,2), UBOUND(OutData%V,2) + DO i1 = LBOUND(OutData%V,1), UBOUND(OutData%V,1) + OutData%V(i1,i2,i3,i4,i5) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO + END DO END IF - OutData%TgridStart = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%TgridStart = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IfW_4Dext_UnPackMisc SUBROUTINE IfW_4Dext_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -779,12 +765,18 @@ SUBROUTINE IfW_4Dext_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%n))-1 ) = PACK(InData%n,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%n) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%delta))-1 ) = PACK(InData%delta,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%delta) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%pZero))-1 ) = PACK(InData%pZero,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%pZero) + DO i1 = LBOUND(InData%n,1), UBOUND(InData%n,1) + IntKiBuf(Int_Xferred) = InData%n(i1) + Int_Xferred = Int_Xferred + 1 + END DO + DO i1 = LBOUND(InData%delta,1), UBOUND(InData%delta,1) + ReKiBuf(Re_Xferred) = InData%delta(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%pZero,1), UBOUND(InData%pZero,1) + ReKiBuf(Re_Xferred) = InData%pZero(i1) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE IfW_4Dext_PackParam SUBROUTINE IfW_4Dext_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -800,12 +792,6 @@ SUBROUTINE IfW_4Dext_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -822,37 +808,22 @@ SUBROUTINE IfW_4Dext_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Xferred = 1 i1_l = LBOUND(OutData%n,1) i1_u = UBOUND(OutData%n,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%n = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%n))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%n) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%n,1), UBOUND(OutData%n,1) + OutData%n(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO i1_l = LBOUND(OutData%delta,1) i1_u = UBOUND(OutData%delta,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%delta = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%delta))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%delta) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%delta,1), UBOUND(OutData%delta,1) + OutData%delta(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%pZero,1) i1_u = UBOUND(OutData%pZero,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%pZero = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%pZero))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%pZero) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%pZero,1), UBOUND(OutData%pZero,1) + OutData%pZero(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE IfW_4Dext_UnPackParam END MODULE IfW_4Dext_Types diff --git a/modules/inflowwind/src/IfW_BladedFFWind_Types.f90 b/modules/inflowwind/src/IfW_BladedFFWind_Types.f90 index 74d536e638..fd15ba6f7d 100644 --- a/modules/inflowwind/src/IfW_BladedFFWind_Types.f90 +++ b/modules/inflowwind/src/IfW_BladedFFWind_Types.f90 @@ -178,14 +178,14 @@ SUBROUTINE IfW_BladedFFWind_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, E Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%WindFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%WindFileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TowerFileExist , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%SumFileUnit - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%WindFileName) + IntKiBuf(Int_Xferred) = ICHAR(InData%WindFileName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%TowerFileExist, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%SumFileUnit + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IfW_BladedFFWind_PackInitInput SUBROUTINE IfW_BladedFFWind_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -201,12 +201,6 @@ SUBROUTINE IfW_BladedFFWind_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (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 @@ -224,14 +218,14 @@ SUBROUTINE IfW_BladedFFWind_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%WindFileName) - OutData%WindFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%TowerFileExist = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%SumFileUnit = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%WindFileName) + OutData%WindFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%TowerFileExist = TRANSFER(IntKiBuf(Int_Xferred), OutData%TowerFileExist) + Int_Xferred = Int_Xferred + 1 + OutData%SumFileUnit = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IfW_BladedFFWind_UnPackInitInput SUBROUTINE IfW_BladedFFWind_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -376,8 +370,10 @@ SUBROUTINE IfW_BladedFFWind_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TI))-1 ) = PACK(InData%TI,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TI) + DO i1 = LBOUND(InData%TI,1), UBOUND(InData%TI,1) + ReKiBuf(Re_Xferred) = InData%TI(i1) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE IfW_BladedFFWind_PackInitOutput SUBROUTINE IfW_BladedFFWind_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -393,12 +389,6 @@ SUBROUTINE IfW_BladedFFWind_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -455,15 +445,10 @@ SUBROUTINE IfW_BladedFFWind_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdat IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) i1_l = LBOUND(OutData%TI,1) i1_u = UBOUND(OutData%TI,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%TI = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TI))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TI) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TI,1), UBOUND(OutData%TI,1) + OutData%TI(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE IfW_BladedFFWind_UnPackInitOutput SUBROUTINE IfW_BladedFFWind_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) @@ -557,8 +542,8 @@ SUBROUTINE IfW_BladedFFWind_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TimeIndex - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TimeIndex + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IfW_BladedFFWind_PackMisc SUBROUTINE IfW_BladedFFWind_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -574,12 +559,6 @@ SUBROUTINE IfW_BladedFFWind_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IfW_BladedFFWind_UnPackMisc' @@ -593,8 +572,8 @@ SUBROUTINE IfW_BladedFFWind_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%TimeIndex = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%TimeIndex = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IfW_BladedFFWind_UnPackMisc SUBROUTINE IfW_BladedFFWind_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -782,12 +761,12 @@ SUBROUTINE IfW_BladedFFWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Periodic , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TowerDataExist , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%Periodic, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TowerDataExist, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 IF ( .NOT. ALLOCATED(InData%FFData) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -807,8 +786,16 @@ SUBROUTINE IfW_BladedFFWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FFData,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FFData)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FFData))-1 ) = PACK(InData%FFData,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FFData) + DO i4 = LBOUND(InData%FFData,4), UBOUND(InData%FFData,4) + DO i3 = LBOUND(InData%FFData,3), UBOUND(InData%FFData,3) + DO i2 = LBOUND(InData%FFData,2), UBOUND(InData%FFData,2) + DO i1 = LBOUND(InData%FFData,1), UBOUND(InData%FFData,1) + ReKiBuf(Re_Xferred) = InData%FFData(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%FFTower) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -826,45 +813,51 @@ SUBROUTINE IfW_BladedFFWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FFTower,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FFTower)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FFTower))-1 ) = PACK(InData%FFTower,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FFTower) + DO i3 = LBOUND(InData%FFTower,3), UBOUND(InData%FFTower,3) + DO i2 = LBOUND(InData%FFTower,2), UBOUND(InData%FFTower,2) + DO i1 = LBOUND(InData%FFTower,1), UBOUND(InData%FFTower,1) + ReKiBuf(Re_Xferred) = InData%FFTower(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%FFDTime - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%FFRate - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%FFYHWid - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%FFZHWid - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RefHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GridBase - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%InitXPosition - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%InvFFYD - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%InvFFZD - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%InvMFFWS - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MeanFFWS - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TotalTime - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NFFComp - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NFFSteps - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NYGrids - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NZGrids - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NTGrids - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WindFileFormat - Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FFDTime + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FFRate + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FFYHWid + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FFZHWid + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RefHt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GridBase + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%InitXPosition + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%InvFFYD + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%InvFFZD + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%InvMFFWS + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MeanFFWS + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TotalTime + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NFFComp + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NFFSteps + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NYGrids + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NZGrids + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NTGrids + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WindFileFormat + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IfW_BladedFFWind_PackParam SUBROUTINE IfW_BladedFFWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -880,12 +873,6 @@ SUBROUTINE IfW_BladedFFWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (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 @@ -903,12 +890,12 @@ SUBROUTINE IfW_BladedFFWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%Periodic = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%TowerDataExist = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%Periodic = TRANSFER(IntKiBuf(Int_Xferred), OutData%Periodic) + Int_Xferred = Int_Xferred + 1 + OutData%TowerDataExist = TRANSFER(IntKiBuf(Int_Xferred), OutData%TowerDataExist) + Int_Xferred = Int_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FFData not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -931,15 +918,16 @@ SUBROUTINE IfW_BladedFFWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FFData.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%FFData)>0) OutData%FFData = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FFData))-1 ), mask4, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%FFData) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%FFData,4), UBOUND(OutData%FFData,4) + DO i3 = LBOUND(OutData%FFData,3), UBOUND(OutData%FFData,3) + DO i2 = LBOUND(OutData%FFData,2), UBOUND(OutData%FFData,2) + DO i1 = LBOUND(OutData%FFData,1), UBOUND(OutData%FFData,1) + OutData%FFData(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FFTower not allocated Int_Xferred = Int_Xferred + 1 @@ -960,52 +948,51 @@ SUBROUTINE IfW_BladedFFWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FFTower.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%FFTower)>0) OutData%FFTower = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FFTower))-1 ), mask3, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%FFTower) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%FFTower,3), UBOUND(OutData%FFTower,3) + DO i2 = LBOUND(OutData%FFTower,2), UBOUND(OutData%FFTower,2) + DO i1 = LBOUND(OutData%FFTower,1), UBOUND(OutData%FFTower,1) + OutData%FFTower(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - OutData%FFDTime = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%FFRate = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%FFYHWid = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%FFZHWid = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RefHt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GridBase = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%InitXPosition = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%InvFFYD = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%InvFFZD = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%InvMFFWS = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MeanFFWS = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TotalTime = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NFFComp = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NFFSteps = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NYGrids = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NZGrids = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NTGrids = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%WindFileFormat = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%FFDTime = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%FFRate = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%FFYHWid = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%FFZHWid = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RefHt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GridBase = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%InitXPosition = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%InvFFYD = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%InvFFZD = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%InvMFFWS = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MeanFFWS = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TotalTime = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NFFComp = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NFFSteps = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NYGrids = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NZGrids = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NTGrids = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WindFileFormat = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IfW_BladedFFWind_UnPackParam END MODULE IfW_BladedFFWind_Types diff --git a/modules/inflowwind/src/IfW_HAWCWind_Types.f90 b/modules/inflowwind/src/IfW_HAWCWind_Types.f90 index 47bb45034d..63058dc0d0 100644 --- a/modules/inflowwind/src/IfW_HAWCWind_Types.f90 +++ b/modules/inflowwind/src/IfW_HAWCWind_Types.f90 @@ -236,43 +236,49 @@ SUBROUTINE IfW_HAWCWind_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt Int_Xferred = 1 DO i1 = LBOUND(InData%WindFileName,1), UBOUND(InData%WindFileName,1) - DO I = 1, LEN(InData%WindFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%WindFileName(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%SumFileUnit - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%nx - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%ny - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%nz - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%ScaleMethod - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SF))-1 ) = PACK(InData%SF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SF) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SigmaF))-1 ) = PACK(InData%SigmaF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SigmaF) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dx - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dy - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dz - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WindProfileType - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RefHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%URef - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PLExp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Z0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%InitPosition))-1 ) = PACK(InData%InitPosition,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%InitPosition) + DO I = 1, LEN(InData%WindFileName) + IntKiBuf(Int_Xferred) = ICHAR(InData%WindFileName(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + IntKiBuf(Int_Xferred) = InData%SumFileUnit + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nx + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%ny + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nz + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%ScaleMethod + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%SF,1), UBOUND(InData%SF,1) + ReKiBuf(Re_Xferred) = InData%SF(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%SigmaF,1), UBOUND(InData%SigmaF,1) + ReKiBuf(Re_Xferred) = InData%SigmaF(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%dx + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%dy + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%dz + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WindProfileType + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RefHt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%URef + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PLExp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Z0 + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%InitPosition,1), UBOUND(InData%InitPosition,1) + ReKiBuf(Re_Xferred) = InData%InitPosition(i1) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE IfW_HAWCWind_PackInitInput SUBROUTINE IfW_HAWCWind_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -288,12 +294,6 @@ SUBROUTINE IfW_HAWCWind_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (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 @@ -313,78 +313,56 @@ SUBROUTINE IfW_HAWCWind_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er Int_Xferred = 1 i1_l = LBOUND(OutData%WindFileName,1) i1_u = UBOUND(OutData%WindFileName,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. DO i1 = LBOUND(OutData%WindFileName,1), UBOUND(OutData%WindFileName,1) - DO I = 1, LEN(OutData%WindFileName) - OutData%WindFileName(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - DEALLOCATE(mask1) - OutData%SumFileUnit = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%nx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%ny = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%nz = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%ScaleMethod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%WindFileName) + OutData%WindFileName(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + OutData%SumFileUnit = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ny = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nz = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ScaleMethod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%SF,1) i1_u = UBOUND(OutData%SF,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%SF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SF))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SF) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%SF,1), UBOUND(OutData%SF,1) + OutData%SF(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%SigmaF,1) i1_u = UBOUND(OutData%SigmaF,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%SigmaF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SigmaF))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SigmaF) - DEALLOCATE(mask1) - OutData%dx = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%dy = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%dz = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%WindProfileType = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%RefHt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%URef = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PLExp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Z0 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%SigmaF,1), UBOUND(OutData%SigmaF,1) + OutData%SigmaF(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%dx = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%dy = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%dz = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WindProfileType = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%RefHt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%URef = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PLExp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Z0 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%InitPosition,1) i1_u = UBOUND(OutData%InitPosition,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%InitPosition = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%InitPosition))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%InitPosition) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%InitPosition,1), UBOUND(OutData%InitPosition,1) + OutData%InitPosition(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE IfW_HAWCWind_UnPackInitInput SUBROUTINE IfW_HAWCWind_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -529,8 +507,10 @@ SUBROUTINE IfW_HAWCWind_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrS ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SF))-1 ) = PACK(InData%SF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SF) + DO i1 = LBOUND(InData%SF,1), UBOUND(InData%SF,1) + ReKiBuf(Re_Xferred) = InData%SF(i1) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE IfW_HAWCWind_PackInitOutput SUBROUTINE IfW_HAWCWind_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -546,12 +526,6 @@ SUBROUTINE IfW_HAWCWind_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -608,15 +582,10 @@ SUBROUTINE IfW_HAWCWind_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, E IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) i1_l = LBOUND(OutData%SF,1) i1_u = UBOUND(OutData%SF,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%SF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SF))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SF) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%SF,1), UBOUND(OutData%SF,1) + OutData%SF(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE IfW_HAWCWind_UnPackInitOutput SUBROUTINE IfW_HAWCWind_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) @@ -710,8 +679,8 @@ SUBROUTINE IfW_HAWCWind_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyContState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyContState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IfW_HAWCWind_PackContState SUBROUTINE IfW_HAWCWind_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -727,12 +696,6 @@ SUBROUTINE IfW_HAWCWind_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IfW_HAWCWind_UnPackContState' @@ -746,8 +709,8 @@ SUBROUTINE IfW_HAWCWind_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyContState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyContState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IfW_HAWCWind_UnPackContState SUBROUTINE IfW_HAWCWind_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) @@ -841,8 +804,8 @@ SUBROUTINE IfW_HAWCWind_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyDiscState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyDiscState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IfW_HAWCWind_PackDiscState SUBROUTINE IfW_HAWCWind_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -858,12 +821,6 @@ SUBROUTINE IfW_HAWCWind_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IfW_HAWCWind_UnPackDiscState' @@ -877,8 +834,8 @@ SUBROUTINE IfW_HAWCWind_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyDiscState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyDiscState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IfW_HAWCWind_UnPackDiscState SUBROUTINE IfW_HAWCWind_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) @@ -972,8 +929,8 @@ SUBROUTINE IfW_HAWCWind_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Err Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyConstrState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IfW_HAWCWind_PackConstrState SUBROUTINE IfW_HAWCWind_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -989,12 +946,6 @@ SUBROUTINE IfW_HAWCWind_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IfW_HAWCWind_UnPackConstrState' @@ -1008,8 +959,8 @@ SUBROUTINE IfW_HAWCWind_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyConstrState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyConstrState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IfW_HAWCWind_UnPackConstrState SUBROUTINE IfW_HAWCWind_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -1103,8 +1054,8 @@ SUBROUTINE IfW_HAWCWind_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrS Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyOtherState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyOtherState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IfW_HAWCWind_PackOtherState SUBROUTINE IfW_HAWCWind_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1120,12 +1071,6 @@ SUBROUTINE IfW_HAWCWind_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IfW_HAWCWind_UnPackOtherState' @@ -1139,8 +1084,8 @@ SUBROUTINE IfW_HAWCWind_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyOtherState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyOtherState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IfW_HAWCWind_UnPackOtherState SUBROUTINE IfW_HAWCWind_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) @@ -1234,8 +1179,8 @@ SUBROUTINE IfW_HAWCWind_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyMiscVar - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyMiscVar + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IfW_HAWCWind_PackMisc SUBROUTINE IfW_HAWCWind_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1251,12 +1196,6 @@ SUBROUTINE IfW_HAWCWind_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IfW_HAWCWind_UnPackMisc' @@ -1270,8 +1209,8 @@ SUBROUTINE IfW_HAWCWind_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyMiscVar = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyMiscVar = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IfW_HAWCWind_UnPackMisc SUBROUTINE IfW_HAWCWind_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -1417,14 +1356,14 @@ SUBROUTINE IfW_HAWCWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%nx - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%ny - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%nz - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RefHt - Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nx + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%ny + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nz + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RefHt + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%HAWCData) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1444,25 +1383,35 @@ SUBROUTINE IfW_HAWCWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HAWCData,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%HAWCData)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%HAWCData))-1 ) = PACK(InData%HAWCData,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%HAWCData) + DO i4 = LBOUND(InData%HAWCData,4), UBOUND(InData%HAWCData,4) + DO i3 = LBOUND(InData%HAWCData,3), UBOUND(InData%HAWCData,3) + DO i2 = LBOUND(InData%HAWCData,2), UBOUND(InData%HAWCData,2) + DO i1 = LBOUND(InData%HAWCData,1), UBOUND(InData%HAWCData,1) + ReKiBuf(Re_Xferred) = InData%HAWCData(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%InitPosition))-1 ) = PACK(InData%InitPosition,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%InitPosition) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GridBase - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%LengthX - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%LengthYHalf - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%deltaXInv - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%deltaYInv - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%deltaZInv - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%URef - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%InitPosition,1), UBOUND(InData%InitPosition,1) + ReKiBuf(Re_Xferred) = InData%InitPosition(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%GridBase + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%LengthX + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%LengthYHalf + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%deltaXInv + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%deltaYInv + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%deltaZInv + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%URef + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IfW_HAWCWind_PackParam SUBROUTINE IfW_HAWCWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1478,12 +1427,6 @@ SUBROUTINE IfW_HAWCWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (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 @@ -1501,14 +1444,14 @@ SUBROUTINE IfW_HAWCWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%nx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%ny = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%nz = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%RefHt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%nx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ny = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nz = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%RefHt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! HAWCData not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1531,41 +1474,37 @@ SUBROUTINE IfW_HAWCWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%HAWCData.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%HAWCData)>0) OutData%HAWCData = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%HAWCData))-1 ), mask4, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%HAWCData) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%HAWCData,4), UBOUND(OutData%HAWCData,4) + DO i3 = LBOUND(OutData%HAWCData,3), UBOUND(OutData%HAWCData,3) + DO i2 = LBOUND(OutData%HAWCData,2), UBOUND(OutData%HAWCData,2) + DO i1 = LBOUND(OutData%HAWCData,1), UBOUND(OutData%HAWCData,1) + OutData%HAWCData(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO END IF i1_l = LBOUND(OutData%InitPosition,1) i1_u = UBOUND(OutData%InitPosition,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%InitPosition = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%InitPosition))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%InitPosition) - DEALLOCATE(mask1) - OutData%GridBase = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%LengthX = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%LengthYHalf = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%deltaXInv = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%deltaYInv = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%deltaZInv = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%URef = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%InitPosition,1), UBOUND(OutData%InitPosition,1) + OutData%InitPosition(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%GridBase = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LengthX = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LengthYHalf = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%deltaXInv = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%deltaYInv = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%deltaZInv = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%URef = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IfW_HAWCWind_UnPackParam SUBROUTINE IfW_HAWCWind_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -1694,8 +1633,12 @@ SUBROUTINE IfW_HAWCWind_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Position,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Position)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Position))-1 ) = PACK(InData%Position,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Position) + DO i2 = LBOUND(InData%Position,2), UBOUND(InData%Position,2) + DO i1 = LBOUND(InData%Position,1), UBOUND(InData%Position,1) + ReKiBuf(Re_Xferred) = InData%Position(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE IfW_HAWCWind_PackInput @@ -1712,12 +1655,6 @@ SUBROUTINE IfW_HAWCWind_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -1749,15 +1686,12 @@ SUBROUTINE IfW_HAWCWind_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Position.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Position)>0) OutData%Position = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Position))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Position) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Position,2), UBOUND(OutData%Position,2) + DO i1 = LBOUND(OutData%Position,1), UBOUND(OutData%Position,1) + OutData%Position(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE IfW_HAWCWind_UnPackInput diff --git a/modules/inflowwind/src/IfW_TSFFWind_Types.f90 b/modules/inflowwind/src/IfW_TSFFWind_Types.f90 index 5184d52280..687f7eb742 100644 --- a/modules/inflowwind/src/IfW_TSFFWind_Types.f90 +++ b/modules/inflowwind/src/IfW_TSFFWind_Types.f90 @@ -174,12 +174,12 @@ SUBROUTINE IfW_TSFFWind_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%WindFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%WindFileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%SumFileUnit - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%WindFileName) + IntKiBuf(Int_Xferred) = ICHAR(InData%WindFileName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%SumFileUnit + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IfW_TSFFWind_PackInitInput SUBROUTINE IfW_TSFFWind_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -195,12 +195,6 @@ SUBROUTINE IfW_TSFFWind_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (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 @@ -218,12 +212,12 @@ SUBROUTINE IfW_TSFFWind_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%WindFileName) - OutData%WindFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%SumFileUnit = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%WindFileName) + OutData%WindFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%SumFileUnit = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IfW_TSFFWind_UnPackInitInput SUBROUTINE IfW_TSFFWind_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -380,12 +374,6 @@ SUBROUTINE IfW_TSFFWind_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IfW_TSFFWind_UnPackInitOutput' @@ -532,8 +520,8 @@ SUBROUTINE IfW_TSFFWind_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TimeIndex - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TimeIndex + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IfW_TSFFWind_PackMisc SUBROUTINE IfW_TSFFWind_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -549,12 +537,6 @@ SUBROUTINE IfW_TSFFWind_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IfW_TSFFWind_UnPackMisc' @@ -568,8 +550,8 @@ SUBROUTINE IfW_TSFFWind_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%TimeIndex = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%TimeIndex = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IfW_TSFFWind_UnPackMisc SUBROUTINE IfW_TSFFWind_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -757,12 +739,12 @@ SUBROUTINE IfW_TSFFWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TowerDataExist , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Periodic , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TowerDataExist, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%Periodic, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%FFData) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -782,8 +764,16 @@ SUBROUTINE IfW_TSFFWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FFData,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FFData)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FFData))-1 ) = PACK(InData%FFData,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FFData) + DO i4 = LBOUND(InData%FFData,4), UBOUND(InData%FFData,4) + DO i3 = LBOUND(InData%FFData,3), UBOUND(InData%FFData,3) + DO i2 = LBOUND(InData%FFData,2), UBOUND(InData%FFData,2) + DO i1 = LBOUND(InData%FFData,1), UBOUND(InData%FFData,1) + ReKiBuf(Re_Xferred) = InData%FFData(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%FFTower) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -801,45 +791,51 @@ SUBROUTINE IfW_TSFFWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FFTower,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FFTower)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FFTower))-1 ) = PACK(InData%FFTower,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FFTower) + DO i3 = LBOUND(InData%FFTower,3), UBOUND(InData%FFTower,3) + DO i2 = LBOUND(InData%FFTower,2), UBOUND(InData%FFTower,2) + DO i1 = LBOUND(InData%FFTower,1), UBOUND(InData%FFTower,1) + ReKiBuf(Re_Xferred) = InData%FFTower(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%FFDTime - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%FFRate - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%FFYHWid - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%FFZHWid - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RefHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GridBase - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%InitXPosition - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%InvFFYD - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%InvFFZD - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%InvMFFWS - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MeanFFWS - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TotalTime - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NFFComp - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NFFSteps - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NYGrids - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NZGrids - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NTGrids - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WindFileFormat - Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FFDTime + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FFRate + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FFYHWid + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%FFZHWid + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RefHt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GridBase + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%InitXPosition + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%InvFFYD + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%InvFFZD + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%InvMFFWS + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MeanFFWS + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TotalTime + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NFFComp + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NFFSteps + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NYGrids + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NZGrids + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NTGrids + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WindFileFormat + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IfW_TSFFWind_PackParam SUBROUTINE IfW_TSFFWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -855,12 +851,6 @@ SUBROUTINE IfW_TSFFWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (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 @@ -878,12 +868,12 @@ SUBROUTINE IfW_TSFFWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%TowerDataExist = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%Periodic = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%TowerDataExist = TRANSFER(IntKiBuf(Int_Xferred), OutData%TowerDataExist) + Int_Xferred = Int_Xferred + 1 + OutData%Periodic = TRANSFER(IntKiBuf(Int_Xferred), OutData%Periodic) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FFData not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -906,15 +896,16 @@ SUBROUTINE IfW_TSFFWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FFData.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%FFData)>0) OutData%FFData = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FFData))-1 ), mask4, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%FFData) - DEALLOCATE(mask4) + DO i4 = LBOUND(OutData%FFData,4), UBOUND(OutData%FFData,4) + DO i3 = LBOUND(OutData%FFData,3), UBOUND(OutData%FFData,3) + DO i2 = LBOUND(OutData%FFData,2), UBOUND(OutData%FFData,2) + DO i1 = LBOUND(OutData%FFData,1), UBOUND(OutData%FFData,1) + OutData%FFData(i1,i2,i3,i4) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FFTower not allocated Int_Xferred = Int_Xferred + 1 @@ -935,52 +926,51 @@ SUBROUTINE IfW_TSFFWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FFTower.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%FFTower)>0) OutData%FFTower = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FFTower))-1 ), mask3, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%FFTower) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%FFTower,3), UBOUND(OutData%FFTower,3) + DO i2 = LBOUND(OutData%FFTower,2), UBOUND(OutData%FFTower,2) + DO i1 = LBOUND(OutData%FFTower,1), UBOUND(OutData%FFTower,1) + OutData%FFTower(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - OutData%FFDTime = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%FFRate = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%FFYHWid = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%FFZHWid = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RefHt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GridBase = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%InitXPosition = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%InvFFYD = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%InvFFZD = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%InvMFFWS = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%MeanFFWS = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TotalTime = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NFFComp = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NFFSteps = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NYGrids = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NZGrids = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NTGrids = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%WindFileFormat = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%FFDTime = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%FFRate = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%FFYHWid = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%FFZHWid = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RefHt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GridBase = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%InitXPosition = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%InvFFYD = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%InvFFZD = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%InvMFFWS = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%MeanFFWS = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TotalTime = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NFFComp = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NFFSteps = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NYGrids = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NZGrids = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NTGrids = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WindFileFormat = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IfW_TSFFWind_UnPackParam END MODULE IfW_TSFFWind_Types diff --git a/modules/inflowwind/src/IfW_UniformWind_Types.f90 b/modules/inflowwind/src/IfW_UniformWind_Types.f90 index 740539a6f2..882554e796 100644 --- a/modules/inflowwind/src/IfW_UniformWind_Types.f90 +++ b/modules/inflowwind/src/IfW_UniformWind_Types.f90 @@ -180,16 +180,16 @@ SUBROUTINE IfW_UniformWind_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Er Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%WindFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%WindFileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ReferenceHeight - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RefLength - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%SumFileUnit - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%WindFileName) + IntKiBuf(Int_Xferred) = ICHAR(InData%WindFileName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + ReKiBuf(Re_Xferred) = InData%ReferenceHeight + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RefLength + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%SumFileUnit + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IfW_UniformWind_PackInitInput SUBROUTINE IfW_UniformWind_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -205,12 +205,6 @@ SUBROUTINE IfW_UniformWind_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -225,16 +219,16 @@ SUBROUTINE IfW_UniformWind_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%WindFileName) - OutData%WindFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%ReferenceHeight = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RefLength = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SumFileUnit = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%WindFileName) + OutData%WindFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%ReferenceHeight = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RefLength = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SumFileUnit = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IfW_UniformWind_UnPackInitInput SUBROUTINE IfW_UniformWind_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -385,14 +379,16 @@ SUBROUTINE IfW_UniformWind_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, E ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%WindFileDT - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WindFileTRange))-1 ) = PACK(InData%WindFileTRange,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WindFileTRange) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WindFileNumTSteps - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%WindFileConstantDT , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%WindFileDT + Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(InData%WindFileTRange,1), UBOUND(InData%WindFileTRange,1) + ReKiBuf(Re_Xferred) = InData%WindFileTRange(i1) + Re_Xferred = Re_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%WindFileNumTSteps + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%WindFileConstantDT, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IfW_UniformWind_PackInitOutput SUBROUTINE IfW_UniformWind_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -408,12 +404,6 @@ SUBROUTINE IfW_UniformWind_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -468,23 +458,18 @@ SUBROUTINE IfW_UniformWind_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%WindFileDT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%WindFileDT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 i1_l = LBOUND(OutData%WindFileTRange,1) i1_u = UBOUND(OutData%WindFileTRange,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%WindFileTRange = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WindFileTRange))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WindFileTRange) - DEALLOCATE(mask1) - OutData%WindFileNumTSteps = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%WindFileConstantDT = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%WindFileTRange,1), UBOUND(OutData%WindFileTRange,1) + OutData%WindFileTRange(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%WindFileNumTSteps = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WindFileConstantDT = TRANSFER(IntKiBuf(Int_Xferred), OutData%WindFileConstantDT) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IfW_UniformWind_UnPackInitOutput SUBROUTINE IfW_UniformWind_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) @@ -578,8 +563,8 @@ SUBROUTINE IfW_UniformWind_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TimeIndex - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TimeIndex + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IfW_UniformWind_PackMisc SUBROUTINE IfW_UniformWind_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -595,12 +580,6 @@ SUBROUTINE IfW_UniformWind_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IfW_UniformWind_UnPackMisc' @@ -614,8 +593,8 @@ SUBROUTINE IfW_UniformWind_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%TimeIndex = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%TimeIndex = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IfW_UniformWind_UnPackMisc SUBROUTINE IfW_UniformWind_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -884,8 +863,10 @@ SUBROUTINE IfW_UniformWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TData,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TData)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TData))-1 ) = PACK(InData%TData,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TData) + DO i1 = LBOUND(InData%TData,1), UBOUND(InData%TData,1) + ReKiBuf(Re_Xferred) = InData%TData(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%DELTA) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -897,8 +878,10 @@ SUBROUTINE IfW_UniformWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DELTA,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DELTA)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%DELTA))-1 ) = PACK(InData%DELTA,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%DELTA) + DO i1 = LBOUND(InData%DELTA,1), UBOUND(InData%DELTA,1) + ReKiBuf(Re_Xferred) = InData%DELTA(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%V) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -910,8 +893,10 @@ SUBROUTINE IfW_UniformWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta IntKiBuf( Int_Xferred + 1) = UBOUND(InData%V,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%V)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%V))-1 ) = PACK(InData%V,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%V) + DO i1 = LBOUND(InData%V,1), UBOUND(InData%V,1) + ReKiBuf(Re_Xferred) = InData%V(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%VZ) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -923,8 +908,10 @@ SUBROUTINE IfW_UniformWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VZ,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%VZ)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%VZ))-1 ) = PACK(InData%VZ,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%VZ) + DO i1 = LBOUND(InData%VZ,1), UBOUND(InData%VZ,1) + ReKiBuf(Re_Xferred) = InData%VZ(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%HSHR) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -936,8 +923,10 @@ SUBROUTINE IfW_UniformWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta IntKiBuf( Int_Xferred + 1) = UBOUND(InData%HSHR,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%HSHR)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%HSHR))-1 ) = PACK(InData%HSHR,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%HSHR) + DO i1 = LBOUND(InData%HSHR,1), UBOUND(InData%HSHR,1) + ReKiBuf(Re_Xferred) = InData%HSHR(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%VSHR) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -949,8 +938,10 @@ SUBROUTINE IfW_UniformWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VSHR,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%VSHR)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%VSHR))-1 ) = PACK(InData%VSHR,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%VSHR) + DO i1 = LBOUND(InData%VSHR,1), UBOUND(InData%VSHR,1) + ReKiBuf(Re_Xferred) = InData%VSHR(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%VLINSHR) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -962,8 +953,10 @@ SUBROUTINE IfW_UniformWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VLINSHR,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%VLINSHR)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%VLINSHR))-1 ) = PACK(InData%VLINSHR,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%VLINSHR) + DO i1 = LBOUND(InData%VLINSHR,1), UBOUND(InData%VLINSHR,1) + ReKiBuf(Re_Xferred) = InData%VLINSHR(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%VGUST) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -975,15 +968,17 @@ SUBROUTINE IfW_UniformWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VGUST,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%VGUST)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%VGUST))-1 ) = PACK(InData%VGUST,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%VGUST) + DO i1 = LBOUND(InData%VGUST,1), UBOUND(InData%VGUST,1) + ReKiBuf(Re_Xferred) = InData%VGUST(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RefHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RefLength - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumDataLines - Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RefHt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RefLength + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumDataLines + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IfW_UniformWind_PackParam SUBROUTINE IfW_UniformWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -999,12 +994,6 @@ SUBROUTINE IfW_UniformWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1032,15 +1021,10 @@ SUBROUTINE IfW_UniformWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TData.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TData)>0) OutData%TData = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TData))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TData) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TData,1), UBOUND(OutData%TData,1) + OutData%TData(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DELTA not allocated Int_Xferred = Int_Xferred + 1 @@ -1055,15 +1039,10 @@ SUBROUTINE IfW_UniformWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DELTA.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%DELTA)>0) OutData%DELTA = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%DELTA))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%DELTA) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%DELTA,1), UBOUND(OutData%DELTA,1) + OutData%DELTA(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! V not allocated Int_Xferred = Int_Xferred + 1 @@ -1078,15 +1057,10 @@ SUBROUTINE IfW_UniformWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%V.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%V)>0) OutData%V = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%V))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%V) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%V,1), UBOUND(OutData%V,1) + OutData%V(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VZ not allocated Int_Xferred = Int_Xferred + 1 @@ -1101,15 +1075,10 @@ SUBROUTINE IfW_UniformWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VZ.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%VZ)>0) OutData%VZ = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%VZ))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%VZ) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%VZ,1), UBOUND(OutData%VZ,1) + OutData%VZ(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! HSHR not allocated Int_Xferred = Int_Xferred + 1 @@ -1124,15 +1093,10 @@ SUBROUTINE IfW_UniformWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%HSHR.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%HSHR)>0) OutData%HSHR = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%HSHR))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%HSHR) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%HSHR,1), UBOUND(OutData%HSHR,1) + OutData%HSHR(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VSHR not allocated Int_Xferred = Int_Xferred + 1 @@ -1147,15 +1111,10 @@ SUBROUTINE IfW_UniformWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VSHR.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%VSHR)>0) OutData%VSHR = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%VSHR))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%VSHR) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%VSHR,1), UBOUND(OutData%VSHR,1) + OutData%VSHR(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VLINSHR not allocated Int_Xferred = Int_Xferred + 1 @@ -1170,15 +1129,10 @@ SUBROUTINE IfW_UniformWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VLINSHR.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%VLINSHR)>0) OutData%VLINSHR = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%VLINSHR))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%VLINSHR) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%VLINSHR,1), UBOUND(OutData%VLINSHR,1) + OutData%VLINSHR(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VGUST not allocated Int_Xferred = Int_Xferred + 1 @@ -1193,22 +1147,17 @@ SUBROUTINE IfW_UniformWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VGUST.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%VGUST)>0) OutData%VGUST = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%VGUST))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%VGUST) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%VGUST,1), UBOUND(OutData%VGUST,1) + OutData%VGUST(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%RefHt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RefLength = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NumDataLines = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%RefHt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RefLength = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NumDataLines = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE IfW_UniformWind_UnPackParam SUBROUTINE IfW_UniformWind_CopyIntrp( SrcIntrpData, DstIntrpData, CtrlCode, ErrStat, ErrMsg ) @@ -1314,20 +1263,20 @@ SUBROUTINE IfW_UniformWind_PackIntrp( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DELTA - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%V - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%VZ - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HSHR - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%VSHR - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%VLINSHR - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%VGUST - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DELTA + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%V + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VZ + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HSHR + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VSHR + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VLINSHR + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VGUST + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IfW_UniformWind_PackIntrp SUBROUTINE IfW_UniformWind_UnPackIntrp( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1343,12 +1292,6 @@ SUBROUTINE IfW_UniformWind_UnPackIntrp( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IfW_UniformWind_UnPackIntrp' @@ -1362,20 +1305,20 @@ SUBROUTINE IfW_UniformWind_UnPackIntrp( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DELTA = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%V = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%VZ = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HSHR = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%VSHR = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%VLINSHR = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%VGUST = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DELTA = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%V = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%VZ = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HSHR = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%VSHR = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%VLINSHR = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%VGUST = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IfW_UniformWind_UnPackIntrp END MODULE IfW_UniformWind_Types diff --git a/modules/inflowwind/src/IfW_UserWind_Types.f90 b/modules/inflowwind/src/IfW_UserWind_Types.f90 index a46c2f44c1..1fa5c484ac 100644 --- a/modules/inflowwind/src/IfW_UserWind_Types.f90 +++ b/modules/inflowwind/src/IfW_UserWind_Types.f90 @@ -145,10 +145,10 @@ SUBROUTINE IfW_UserWind_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%WindFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%WindFileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(InData%WindFileName) + IntKiBuf(Int_Xferred) = ICHAR(InData%WindFileName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE IfW_UserWind_PackInitInput SUBROUTINE IfW_UserWind_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -164,12 +164,6 @@ SUBROUTINE IfW_UserWind_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IfW_UserWind_UnPackInitInput' @@ -183,10 +177,10 @@ SUBROUTINE IfW_UserWind_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%WindFileName) - OutData%WindFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%WindFileName) + OutData%WindFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE IfW_UserWind_UnPackInitInput SUBROUTINE IfW_UserWind_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -343,12 +337,6 @@ SUBROUTINE IfW_UserWind_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IfW_UserWind_UnPackInitOutput' @@ -495,8 +483,8 @@ SUBROUTINE IfW_UserWind_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyMiscVar - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyMiscVar + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IfW_UserWind_PackMisc SUBROUTINE IfW_UserWind_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -512,12 +500,6 @@ SUBROUTINE IfW_UserWind_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IfW_UserWind_UnPackMisc' @@ -531,8 +513,8 @@ SUBROUTINE IfW_UserWind_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyMiscVar = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyMiscVar = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IfW_UserWind_UnPackMisc SUBROUTINE IfW_UserWind_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -626,8 +608,8 @@ SUBROUTINE IfW_UserWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dummy - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%dummy + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IfW_UserWind_PackParam SUBROUTINE IfW_UserWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -643,12 +625,6 @@ SUBROUTINE IfW_UserWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'IfW_UserWind_UnPackParam' @@ -662,8 +638,8 @@ SUBROUTINE IfW_UserWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%dummy = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%dummy = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE IfW_UserWind_UnPackParam END MODULE IfW_UserWind_Types diff --git a/modules/inflowwind/src/InflowWind_Types.f90 b/modules/inflowwind/src/InflowWind_Types.f90 index 4f4ba4c1da..d8f2890b35 100644 --- a/modules/inflowwind/src/InflowWind_Types.f90 +++ b/modules/inflowwind/src/InflowWind_Types.f90 @@ -351,44 +351,52 @@ SUBROUTINE InflowWind_PackWindFileMetaData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%FileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%FileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WindType - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RefHt - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%RefHt_Set , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumTSteps - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%ConstantDT , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TRange))-1 ) = PACK(InData%TRange,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TRange) - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TRange_Limited , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%YRange))-1 ) = PACK(InData%YRange,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%YRange) - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%YRange_Limited , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%ZRange))-1 ) = PACK(InData%ZRange,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%ZRange) - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%ZRange_Limited , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%BinaryFormat - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%IsBinary , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TI))-1 ) = PACK(InData%TI,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TI) - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TI_listed , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%MWS - Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(InData%FileName) + IntKiBuf(Int_Xferred) = ICHAR(InData%FileName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%WindType + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RefHt + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%RefHt_Set, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumTSteps + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%ConstantDT, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%TRange,1), UBOUND(InData%TRange,1) + ReKiBuf(Re_Xferred) = InData%TRange(i1) + Re_Xferred = Re_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = TRANSFER(InData%TRange_Limited, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%YRange,1), UBOUND(InData%YRange,1) + ReKiBuf(Re_Xferred) = InData%YRange(i1) + Re_Xferred = Re_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = TRANSFER(InData%YRange_Limited, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%ZRange,1), UBOUND(InData%ZRange,1) + ReKiBuf(Re_Xferred) = InData%ZRange(i1) + Re_Xferred = Re_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = TRANSFER(InData%ZRange_Limited, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%BinaryFormat + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%IsBinary, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%TI,1), UBOUND(InData%TI,1) + ReKiBuf(Re_Xferred) = InData%TI(i1) + Re_Xferred = Re_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = TRANSFER(InData%TI_listed, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%MWS + Re_Xferred = Re_Xferred + 1 END SUBROUTINE InflowWind_PackWindFileMetaData SUBROUTINE InflowWind_UnPackWindFileMetaData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -404,12 +412,6 @@ SUBROUTINE InflowWind_UnPackWindFileMetaData( ReKiBuf, DbKiBuf, IntKiBuf, Outdat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -425,80 +427,60 @@ SUBROUTINE InflowWind_UnPackWindFileMetaData( ReKiBuf, DbKiBuf, IntKiBuf, Outdat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%FileName) - OutData%FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%WindType = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%RefHt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RefHt_Set = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%NumTSteps = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%ConstantDT = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%FileName) + OutData%FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%WindType = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%RefHt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RefHt_Set = TRANSFER(IntKiBuf(Int_Xferred), OutData%RefHt_Set) + Int_Xferred = Int_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%NumTSteps = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ConstantDT = TRANSFER(IntKiBuf(Int_Xferred), OutData%ConstantDT) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%TRange,1) i1_u = UBOUND(OutData%TRange,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%TRange = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TRange))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TRange) - DEALLOCATE(mask1) - OutData%TRange_Limited = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%TRange,1), UBOUND(OutData%TRange,1) + OutData%TRange(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%TRange_Limited = TRANSFER(IntKiBuf(Int_Xferred), OutData%TRange_Limited) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%YRange,1) i1_u = UBOUND(OutData%YRange,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%YRange = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%YRange))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%YRange) - DEALLOCATE(mask1) - OutData%YRange_Limited = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%YRange,1), UBOUND(OutData%YRange,1) + OutData%YRange(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%YRange_Limited = TRANSFER(IntKiBuf(Int_Xferred), OutData%YRange_Limited) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%ZRange,1) i1_u = UBOUND(OutData%ZRange,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%ZRange = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%ZRange))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%ZRange) - DEALLOCATE(mask1) - OutData%ZRange_Limited = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%BinaryFormat = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%IsBinary = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%ZRange,1), UBOUND(OutData%ZRange,1) + OutData%ZRange(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%ZRange_Limited = TRANSFER(IntKiBuf(Int_Xferred), OutData%ZRange_Limited) + Int_Xferred = Int_Xferred + 1 + OutData%BinaryFormat = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%IsBinary = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsBinary) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%TI,1) i1_u = UBOUND(OutData%TI,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%TI = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TI))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TI) - DEALLOCATE(mask1) - OutData%TI_listed = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%MWS = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%TI,1), UBOUND(OutData%TI,1) + OutData%TI(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%TI_listed = TRANSFER(IntKiBuf(Int_Xferred), OutData%TI_listed) + Int_Xferred = Int_Xferred + 1 + OutData%MWS = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE InflowWind_UnPackWindFileMetaData SUBROUTINE InflowWind_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, ErrStat, ErrMsg ) @@ -763,14 +745,14 @@ SUBROUTINE InflowWind_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%EchoFlag , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WindType - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PropagationDir - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NWindVel - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%EchoFlag, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WindType + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PropagationDir + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NWindVel + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WindVxiList) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -781,8 +763,10 @@ SUBROUTINE InflowWind_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindVxiList,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WindVxiList)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WindVxiList))-1 ) = PACK(InData%WindVxiList,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WindVxiList) + DO i1 = LBOUND(InData%WindVxiList,1), UBOUND(InData%WindVxiList,1) + ReKiBuf(Re_Xferred) = InData%WindVxiList(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WindVyiList) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -794,8 +778,10 @@ SUBROUTINE InflowWind_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindVyiList,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WindVyiList)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WindVyiList))-1 ) = PACK(InData%WindVyiList,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WindVyiList) + DO i1 = LBOUND(InData%WindVyiList,1), UBOUND(InData%WindVyiList,1) + ReKiBuf(Re_Xferred) = InData%WindVyiList(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WindVziList) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -807,101 +793,105 @@ SUBROUTINE InflowWind_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindVziList,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WindVziList)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WindVziList))-1 ) = PACK(InData%WindVziList,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WindVziList) + DO i1 = LBOUND(InData%WindVziList,1), UBOUND(InData%WindVziList,1) + ReKiBuf(Re_Xferred) = InData%WindVziList(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Steady_HWindSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Steady_RefHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Steady_PLexp - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%Uniform_FileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%Uniform_FileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Uniform_RefHt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Uniform_RefLength - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%TSFF_FileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%TSFF_FileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%BladedFF_FileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%BladedFF_FileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%BladedFF_TowerFile , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%CTTS_CoherentTurb , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%CTTS_FileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%CTTS_FileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%CTTS_Path) - IntKiBuf(Int_Xferred) = ICHAR(InData%CTTS_Path(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%HAWC_FileName_u) - IntKiBuf(Int_Xferred) = ICHAR(InData%HAWC_FileName_u(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%HAWC_FileName_v) - IntKiBuf(Int_Xferred) = ICHAR(InData%HAWC_FileName_v(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%HAWC_FileName_w) - IntKiBuf(Int_Xferred) = ICHAR(InData%HAWC_FileName_w(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%HAWC_nx - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%HAWC_ny - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%HAWC_nz - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HAWC_dx - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HAWC_dy - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HAWC_dz - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HAWC_RefHt - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%HAWC_ScaleMethod - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HAWC_SFx - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HAWC_SFy - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HAWC_SFz - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HAWC_SigmaFx - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HAWC_SigmaFy - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HAWC_SigmaFz - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HAWC_TStart - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HAWC_TEnd - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HAWC_URef - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%HAWC_ProfileType - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HAWC_PLExp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HAWC_Z0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%HAWC_InitPosition))-1 ) = PACK(InData%HAWC_InitPosition,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%HAWC_InitPosition) - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%SumPrint , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Steady_HWindSpeed + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Steady_RefHt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Steady_PLexp + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(InData%Uniform_FileName) + IntKiBuf(Int_Xferred) = ICHAR(InData%Uniform_FileName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + ReKiBuf(Re_Xferred) = InData%Uniform_RefHt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Uniform_RefLength + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(InData%TSFF_FileName) + IntKiBuf(Int_Xferred) = ICHAR(InData%TSFF_FileName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%BladedFF_FileName) + IntKiBuf(Int_Xferred) = ICHAR(InData%BladedFF_FileName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%BladedFF_TowerFile, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%CTTS_CoherentTurb, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%CTTS_FileName) + IntKiBuf(Int_Xferred) = ICHAR(InData%CTTS_FileName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%CTTS_Path) + IntKiBuf(Int_Xferred) = ICHAR(InData%CTTS_Path(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%HAWC_FileName_u) + IntKiBuf(Int_Xferred) = ICHAR(InData%HAWC_FileName_u(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%HAWC_FileName_v) + IntKiBuf(Int_Xferred) = ICHAR(InData%HAWC_FileName_v(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%HAWC_FileName_w) + IntKiBuf(Int_Xferred) = ICHAR(InData%HAWC_FileName_w(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%HAWC_nx + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%HAWC_ny + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%HAWC_nz + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HAWC_dx + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HAWC_dy + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HAWC_dz + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HAWC_RefHt + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%HAWC_ScaleMethod + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HAWC_SFx + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HAWC_SFy + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HAWC_SFz + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HAWC_SigmaFx + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HAWC_SigmaFy + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HAWC_SigmaFz + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HAWC_TStart + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HAWC_TEnd + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HAWC_URef + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%HAWC_ProfileType + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HAWC_PLExp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HAWC_Z0 + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%HAWC_InitPosition,1), UBOUND(InData%HAWC_InitPosition,1) + ReKiBuf(Re_Xferred) = InData%HAWC_InitPosition(i1) + Re_Xferred = Re_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = TRANSFER(InData%SumPrint, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%OutList) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -912,21 +902,23 @@ SUBROUTINE InflowWind_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutList,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) + DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) DO I = 1, LEN(InData%OutList) IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%SensorType - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumPulseGate - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RotorApexOffsetPos))-1 ) = PACK(InData%RotorApexOffsetPos,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RotorApexOffsetPos) - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%LidRadialVel , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%SensorType + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumPulseGate + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%RotorApexOffsetPos,1), UBOUND(InData%RotorApexOffsetPos,1) + ReKiBuf(Re_Xferred) = InData%RotorApexOffsetPos(i1) + Re_Xferred = Re_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = TRANSFER(InData%LidRadialVel, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE InflowWind_PackInputFile SUBROUTINE InflowWind_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -942,12 +934,6 @@ SUBROUTINE InflowWind_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -962,14 +948,14 @@ SUBROUTINE InflowWind_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%EchoFlag = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%WindType = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%PropagationDir = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NWindVel = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%EchoFlag = TRANSFER(IntKiBuf(Int_Xferred), OutData%EchoFlag) + Int_Xferred = Int_Xferred + 1 + OutData%WindType = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%PropagationDir = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NWindVel = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WindVxiList not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -983,15 +969,10 @@ SUBROUTINE InflowWind_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindVxiList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WindVxiList)>0) OutData%WindVxiList = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WindVxiList))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WindVxiList) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WindVxiList,1), UBOUND(OutData%WindVxiList,1) + OutData%WindVxiList(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WindVyiList not allocated Int_Xferred = Int_Xferred + 1 @@ -1006,15 +987,10 @@ SUBROUTINE InflowWind_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindVyiList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WindVyiList)>0) OutData%WindVyiList = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WindVyiList))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WindVyiList) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WindVyiList,1), UBOUND(OutData%WindVyiList,1) + OutData%WindVyiList(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WindVziList not allocated Int_Xferred = Int_Xferred + 1 @@ -1029,117 +1005,107 @@ SUBROUTINE InflowWind_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindVziList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WindVziList)>0) OutData%WindVziList = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WindVziList))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WindVziList) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WindVziList,1), UBOUND(OutData%WindVziList,1) + OutData%WindVziList(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%Steady_HWindSpeed = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Steady_RefHt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Steady_PLexp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%Uniform_FileName) - OutData%Uniform_FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%Uniform_RefHt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Uniform_RefLength = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%TSFF_FileName) - OutData%TSFF_FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%BladedFF_FileName) - OutData%BladedFF_FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%BladedFF_TowerFile = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%CTTS_CoherentTurb = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%CTTS_FileName) - OutData%CTTS_FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%CTTS_Path) - OutData%CTTS_Path(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%HAWC_FileName_u) - OutData%HAWC_FileName_u(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%HAWC_FileName_v) - OutData%HAWC_FileName_v(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%HAWC_FileName_w) - OutData%HAWC_FileName_w(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%HAWC_nx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%HAWC_ny = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%HAWC_nz = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%HAWC_dx = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HAWC_dy = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HAWC_dz = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HAWC_RefHt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HAWC_ScaleMethod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%HAWC_SFx = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HAWC_SFy = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HAWC_SFz = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HAWC_SigmaFx = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HAWC_SigmaFy = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HAWC_SigmaFz = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HAWC_TStart = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HAWC_TEnd = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HAWC_URef = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HAWC_ProfileType = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%HAWC_PLExp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HAWC_Z0 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%Steady_HWindSpeed = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Steady_RefHt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Steady_PLexp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(OutData%Uniform_FileName) + OutData%Uniform_FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%Uniform_RefHt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Uniform_RefLength = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(OutData%TSFF_FileName) + OutData%TSFF_FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%BladedFF_FileName) + OutData%BladedFF_FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%BladedFF_TowerFile = TRANSFER(IntKiBuf(Int_Xferred), OutData%BladedFF_TowerFile) + Int_Xferred = Int_Xferred + 1 + OutData%CTTS_CoherentTurb = TRANSFER(IntKiBuf(Int_Xferred), OutData%CTTS_CoherentTurb) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%CTTS_FileName) + OutData%CTTS_FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%CTTS_Path) + OutData%CTTS_Path(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%HAWC_FileName_u) + OutData%HAWC_FileName_u(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%HAWC_FileName_v) + OutData%HAWC_FileName_v(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%HAWC_FileName_w) + OutData%HAWC_FileName_w(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%HAWC_nx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%HAWC_ny = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%HAWC_nz = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%HAWC_dx = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HAWC_dy = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HAWC_dz = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HAWC_RefHt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HAWC_ScaleMethod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%HAWC_SFx = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HAWC_SFy = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HAWC_SFz = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HAWC_SigmaFx = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HAWC_SigmaFy = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HAWC_SigmaFz = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HAWC_TStart = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HAWC_TEnd = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HAWC_URef = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HAWC_ProfileType = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%HAWC_PLExp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HAWC_Z0 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%HAWC_InitPosition,1) i1_u = UBOUND(OutData%HAWC_InitPosition,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%HAWC_InitPosition = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%HAWC_InitPosition))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%HAWC_InitPosition) - DEALLOCATE(mask1) - OutData%SumPrint = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%HAWC_InitPosition,1), UBOUND(OutData%HAWC_InitPosition,1) + OutData%HAWC_InitPosition(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%SumPrint = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumPrint) + Int_Xferred = Int_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutList not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1153,37 +1119,25 @@ SUBROUTINE InflowWind_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) + DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) DO I = 1, LEN(OutData%OutList) OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF - OutData%SensorType = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumPulseGate = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%SensorType = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumPulseGate = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%RotorApexOffsetPos,1) i1_u = UBOUND(OutData%RotorApexOffsetPos,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%RotorApexOffsetPos = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RotorApexOffsetPos))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RotorApexOffsetPos) - DEALLOCATE(mask1) - OutData%LidRadialVel = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%RotorApexOffsetPos,1), UBOUND(OutData%RotorApexOffsetPos,1) + OutData%RotorApexOffsetPos(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%LidRadialVel = TRANSFER(IntKiBuf(Int_Xferred), OutData%LidRadialVel) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE InflowWind_UnPackInputFile SUBROUTINE InflowWind_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, ErrStat, ErrMsg ) @@ -1351,22 +1305,22 @@ SUBROUTINE InflowWind_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%InputFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Linearize , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Use4Dext , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumWindPoints - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%UseInputFile , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(InData%InputFileName) + IntKiBuf(Int_Xferred) = ICHAR(InData%InputFileName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%Linearize, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%Use4Dext, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumWindPoints + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%UseInputFile, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I CALL InflowWind_Packinputfile( Re_Buf, Db_Buf, Int_Buf, InData%PassedFileData, ErrStat2, ErrMsg2, OnlySize ) ! PassedFileData CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1466,12 +1420,6 @@ SUBROUTINE InflowWind_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_UnPackInitInput' @@ -1485,22 +1433,22 @@ SUBROUTINE InflowWind_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%InputFileName) - OutData%InputFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%Linearize = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%Use4Dext = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NumWindPoints = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%UseInputFile = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%InputFileName) + OutData%InputFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%Linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%Linearize) + Int_Xferred = Int_Xferred + 1 + OutData%Use4Dext = TRANSFER(IntKiBuf(Int_Xferred), OutData%Use4Dext) + Int_Xferred = Int_Xferred + 1 + OutData%NumWindPoints = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%UseInputFile = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseInputFile) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -1906,12 +1854,12 @@ SUBROUTINE InflowWind_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1923,12 +1871,12 @@ SUBROUTINE InflowWind_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + 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) @@ -1996,12 +1944,12 @@ SUBROUTINE InflowWind_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_y,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%LinNames_y,1), UBOUND(InData%LinNames_y,1) + DO 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LinNames_u) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2013,12 +1961,12 @@ SUBROUTINE InflowWind_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_u,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%LinNames_u,1), UBOUND(InData%LinNames_u,1) + DO 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%RotFrame_y) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2030,8 +1978,10 @@ SUBROUTINE InflowWind_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_y,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RotFrame_y)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%RotFrame_y)-1 ) = TRANSFER(PACK( InData%RotFrame_y ,.TRUE.), IntKiBuf(1), SIZE(InData%RotFrame_y)) - Int_Xferred = Int_Xferred + SIZE(InData%RotFrame_y) + DO i1 = LBOUND(InData%RotFrame_y,1), UBOUND(InData%RotFrame_y,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_y(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%RotFrame_u) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2043,8 +1993,10 @@ SUBROUTINE InflowWind_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_u,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RotFrame_u)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%RotFrame_u)-1 ) = TRANSFER(PACK( InData%RotFrame_u ,.TRUE.), IntKiBuf(1), SIZE(InData%RotFrame_u)) - Int_Xferred = Int_Xferred + SIZE(InData%RotFrame_u) + 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 @@ -2056,8 +2008,10 @@ SUBROUTINE InflowWind_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IsLoad_u,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%IsLoad_u)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%IsLoad_u)-1 ) = TRANSFER(PACK( InData%IsLoad_u ,.TRUE.), IntKiBuf(1), SIZE(InData%IsLoad_u)) - Int_Xferred = Int_Xferred + SIZE(InData%IsLoad_u) + DO i1 = LBOUND(InData%IsLoad_u,1), UBOUND(InData%IsLoad_u,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%IsLoad_u(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF END SUBROUTINE InflowWind_PackInitOutput @@ -2074,12 +2028,6 @@ SUBROUTINE InflowWind_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -2107,19 +2055,12 @@ SUBROUTINE InflowWind_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated Int_Xferred = Int_Xferred + 1 @@ -2134,19 +2075,12 @@ SUBROUTINE InflowWind_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -2241,19 +2175,12 @@ SUBROUTINE InflowWind_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%LinNames_y,1), UBOUND(OutData%LinNames_y,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_u not allocated Int_Xferred = Int_Xferred + 1 @@ -2268,19 +2195,12 @@ SUBROUTINE InflowWind_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%LinNames_u,1), UBOUND(OutData%LinNames_u,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_y not allocated Int_Xferred = Int_Xferred + 1 @@ -2295,15 +2215,10 @@ SUBROUTINE InflowWind_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%RotFrame_y)>0) OutData%RotFrame_y = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%RotFrame_y))-1 ), OutData%RotFrame_y), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%RotFrame_y) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%RotFrame_y,1), UBOUND(OutData%RotFrame_y,1) + OutData%RotFrame_y(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_y(i1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_u not allocated Int_Xferred = Int_Xferred + 1 @@ -2318,15 +2233,10 @@ SUBROUTINE InflowWind_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%RotFrame_u)>0) OutData%RotFrame_u = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%RotFrame_u))-1 ), OutData%RotFrame_u), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%RotFrame_u) - DEALLOCATE(mask1) + 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 @@ -2341,15 +2251,10 @@ SUBROUTINE InflowWind_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%IsLoad_u)>0) OutData%IsLoad_u = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%IsLoad_u))-1 ), OutData%IsLoad_u), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%IsLoad_u) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%IsLoad_u,1), UBOUND(OutData%IsLoad_u,1) + OutData%IsLoad_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsLoad_u(i1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF END SUBROUTINE InflowWind_UnPackInitOutput @@ -2615,8 +2520,8 @@ SUBROUTINE InflowWind_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TimeIndex - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TimeIndex + Int_Xferred = Int_Xferred + 1 CALL IfW_UniformWind_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%UniformWind, ErrStat2, ErrMsg2, OnlySize ) ! UniformWind CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2795,8 +2700,10 @@ SUBROUTINE InflowWind_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AllOuts,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AllOuts)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AllOuts))-1 ) = PACK(InData%AllOuts,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AllOuts) + DO i1 = LBOUND(InData%AllOuts,1), UBOUND(InData%AllOuts,1) + ReKiBuf(Re_Xferred) = InData%AllOuts(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WindViUVW) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2811,8 +2718,12 @@ SUBROUTINE InflowWind_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindViUVW,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WindViUVW)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WindViUVW))-1 ) = PACK(InData%WindViUVW,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WindViUVW) + DO i2 = LBOUND(InData%WindViUVW,2), UBOUND(InData%WindViUVW,2) + DO i1 = LBOUND(InData%WindViUVW,1), UBOUND(InData%WindViUVW,1) + ReKiBuf(Re_Xferred) = InData%WindViUVW(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE InflowWind_PackMisc @@ -2829,12 +2740,6 @@ SUBROUTINE InflowWind_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -2850,8 +2755,8 @@ SUBROUTINE InflowWind_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%TimeIndex = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%TimeIndex = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -3105,15 +3010,10 @@ SUBROUTINE InflowWind_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOuts.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%AllOuts)>0) OutData%AllOuts = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AllOuts))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AllOuts) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AllOuts,1), UBOUND(OutData%AllOuts,1) + OutData%AllOuts(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WindViUVW not allocated Int_Xferred = Int_Xferred + 1 @@ -3131,15 +3031,12 @@ SUBROUTINE InflowWind_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindViUVW.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WindViUVW)>0) OutData%WindViUVW = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WindViUVW))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WindViUVW) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WindViUVW,2), UBOUND(OutData%WindViUVW,2) + DO i1 = LBOUND(OutData%WindViUVW,1), UBOUND(OutData%WindViUVW,1) + OutData%WindViUVW(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE InflowWind_UnPackMisc @@ -3513,20 +3410,28 @@ SUBROUTINE InflowWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%RootFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootFileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%CTTS_Flag , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PropagationDir - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RotToWind))-1 ) = PACK(InData%RotToWind,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RotToWind) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RotFromWind))-1 ) = PACK(InData%RotFromWind,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RotFromWind) + DO I = 1, LEN(InData%RootFileName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootFileName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%CTTS_Flag, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PropagationDir + Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(InData%RotToWind,2), UBOUND(InData%RotToWind,2) + DO i1 = LBOUND(InData%RotToWind,1), UBOUND(InData%RotToWind,1) + ReKiBuf(Re_Xferred) = InData%RotToWind(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%RotFromWind,2), UBOUND(InData%RotFromWind,2) + DO i1 = LBOUND(InData%RotFromWind,1), UBOUND(InData%RotFromWind,1) + ReKiBuf(Re_Xferred) = InData%RotFromWind(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO IF ( .NOT. ALLOCATED(InData%WindViXYZprime) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -3540,15 +3445,19 @@ SUBROUTINE InflowWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindViXYZprime,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WindViXYZprime)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WindViXYZprime))-1 ) = PACK(InData%WindViXYZprime,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WindViXYZprime) + DO i2 = LBOUND(InData%WindViXYZprime,2), UBOUND(InData%WindViXYZprime,2) + DO i1 = LBOUND(InData%WindViXYZprime,1), UBOUND(InData%WindViXYZprime,1) + ReKiBuf(Re_Xferred) = InData%WindViXYZprime(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WindType - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ReferenceHeight - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NWindVel - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WindType + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%ReferenceHeight + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NWindVel + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%WindViXYZ) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -3562,8 +3471,12 @@ SUBROUTINE InflowWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WindViXYZ,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WindViXYZ)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WindViXYZ))-1 ) = PACK(InData%WindViXYZ,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WindViXYZ) + DO i2 = LBOUND(InData%WindViXYZ,2), UBOUND(InData%WindViXYZ,2) + DO i1 = LBOUND(InData%WindViXYZ,1), UBOUND(InData%WindViXYZ,1) + ReKiBuf(Re_Xferred) = InData%WindViXYZ(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF CALL IfW_UniformWind_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%UniformWind, ErrStat2, ErrMsg2, OnlySize ) ! UniformWind CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3733,8 +3646,8 @@ SUBROUTINE InflowWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%OutParam) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -3789,8 +3702,12 @@ SUBROUTINE InflowWind_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutParamLinIndx,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%OutParamLinIndx)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%OutParamLinIndx))-1 ) = PACK(InData%OutParamLinIndx,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%OutParamLinIndx) + DO i2 = LBOUND(InData%OutParamLinIndx,2), UBOUND(InData%OutParamLinIndx,2) + DO i1 = LBOUND(InData%OutParamLinIndx,1), UBOUND(InData%OutParamLinIndx,1) + IntKiBuf(Int_Xferred) = InData%OutParamLinIndx(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF CALL Lidar_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%lidar, ErrStat2, ErrMsg2, OnlySize ) ! lidar CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3835,12 +3752,6 @@ SUBROUTINE InflowWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -3856,42 +3767,36 @@ SUBROUTINE InflowWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%RootFileName) - OutData%RootFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%CTTS_Flag = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%PropagationDir = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(OutData%RootFileName) + OutData%RootFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%CTTS_Flag = TRANSFER(IntKiBuf(Int_Xferred), OutData%CTTS_Flag) + Int_Xferred = Int_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%PropagationDir = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%RotToWind,1) i1_u = UBOUND(OutData%RotToWind,1) i2_l = LBOUND(OutData%RotToWind,2) i2_u = UBOUND(OutData%RotToWind,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%RotToWind = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RotToWind))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RotToWind) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%RotToWind,2), UBOUND(OutData%RotToWind,2) + DO i1 = LBOUND(OutData%RotToWind,1), UBOUND(OutData%RotToWind,1) + OutData%RotToWind(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%RotFromWind,1) i1_u = UBOUND(OutData%RotFromWind,1) i2_l = LBOUND(OutData%RotFromWind,2) i2_u = UBOUND(OutData%RotFromWind,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%RotFromWind = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RotFromWind))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RotFromWind) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%RotFromWind,2), UBOUND(OutData%RotFromWind,2) + DO i1 = LBOUND(OutData%RotFromWind,1), UBOUND(OutData%RotFromWind,1) + OutData%RotFromWind(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WindViXYZprime not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3908,22 +3813,19 @@ SUBROUTINE InflowWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindViXYZprime.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WindViXYZprime)>0) OutData%WindViXYZprime = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WindViXYZprime))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WindViXYZprime) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WindViXYZprime,2), UBOUND(OutData%WindViXYZprime,2) + DO i1 = LBOUND(OutData%WindViXYZprime,1), UBOUND(OutData%WindViXYZprime,1) + OutData%WindViXYZprime(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - OutData%WindType = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%ReferenceHeight = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NWindVel = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%WindType = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ReferenceHeight = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NWindVel = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WindViXYZ not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3940,15 +3842,12 @@ SUBROUTINE InflowWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WindViXYZ.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WindViXYZ)>0) OutData%WindViXYZ = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WindViXYZ))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WindViXYZ) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WindViXYZ,2), UBOUND(OutData%WindViXYZ,2) + DO i1 = LBOUND(OutData%WindViXYZ,1), UBOUND(OutData%WindViXYZ,1) + OutData%WindViXYZ(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -4190,8 +4089,8 @@ SUBROUTINE InflowWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParam not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -4264,15 +4163,12 @@ SUBROUTINE InflowWind_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutParamLinIndx.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%OutParamLinIndx)>0) OutData%OutParamLinIndx = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%OutParamLinIndx))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%OutParamLinIndx) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%OutParamLinIndx,2), UBOUND(OutData%OutParamLinIndx,2) + DO i1 = LBOUND(OutData%OutParamLinIndx,1), UBOUND(OutData%OutParamLinIndx,1) + OutData%OutParamLinIndx(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -4464,8 +4360,12 @@ SUBROUTINE InflowWind_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PositionXYZ,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PositionXYZ)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PositionXYZ))-1 ) = PACK(InData%PositionXYZ,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PositionXYZ) + DO i2 = LBOUND(InData%PositionXYZ,2), UBOUND(InData%PositionXYZ,2) + DO i1 = LBOUND(InData%PositionXYZ,1), UBOUND(InData%PositionXYZ,1) + ReKiBuf(Re_Xferred) = InData%PositionXYZ(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF CALL Lidar_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%lidar, ErrStat2, ErrMsg2, OnlySize ) ! lidar CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4510,12 +4410,6 @@ SUBROUTINE InflowWind_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -4547,15 +4441,12 @@ SUBROUTINE InflowWind_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PositionXYZ.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PositionXYZ)>0) OutData%PositionXYZ = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PositionXYZ))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PositionXYZ) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PositionXYZ,2), UBOUND(OutData%PositionXYZ,2) + DO i1 = LBOUND(OutData%PositionXYZ,1), UBOUND(OutData%PositionXYZ,1) + OutData%PositionXYZ(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -4769,8 +4660,12 @@ SUBROUTINE InflowWind_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VelocityUVW,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%VelocityUVW)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%VelocityUVW))-1 ) = PACK(InData%VelocityUVW,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%VelocityUVW) + DO i2 = LBOUND(InData%VelocityUVW,2), UBOUND(InData%VelocityUVW,2) + DO i1 = LBOUND(InData%VelocityUVW,1), UBOUND(InData%VelocityUVW,1) + ReKiBuf(Re_Xferred) = InData%VelocityUVW(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutput) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4782,11 +4677,15 @@ SUBROUTINE InflowWind_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WriteOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WriteOutput))-1 ) = PACK(InData%WriteOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WriteOutput) + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%DiskVel))-1 ) = PACK(InData%DiskVel,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%DiskVel) + DO i1 = LBOUND(InData%DiskVel,1), UBOUND(InData%DiskVel,1) + ReKiBuf(Re_Xferred) = InData%DiskVel(i1) + Re_Xferred = Re_Xferred + 1 + END DO CALL Lidar_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%lidar, ErrStat2, ErrMsg2, OnlySize ) ! lidar CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4830,12 +4729,6 @@ SUBROUTINE InflowWind_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -4867,15 +4760,12 @@ SUBROUTINE InflowWind_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VelocityUVW.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%VelocityUVW)>0) OutData%VelocityUVW = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%VelocityUVW))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%VelocityUVW) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%VelocityUVW,2), UBOUND(OutData%VelocityUVW,2) + DO i1 = LBOUND(OutData%VelocityUVW,1), UBOUND(OutData%VelocityUVW,1) + OutData%VelocityUVW(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutput not allocated Int_Xferred = Int_Xferred + 1 @@ -4890,27 +4780,17 @@ SUBROUTINE InflowWind_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WriteOutput)>0) OutData%WriteOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WriteOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WriteOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF i1_l = LBOUND(OutData%DiskVel,1) i1_u = UBOUND(OutData%DiskVel,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%DiskVel = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%DiskVel))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%DiskVel) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%DiskVel,1), UBOUND(OutData%DiskVel,1) + OutData%DiskVel(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -5044,8 +4924,8 @@ SUBROUTINE InflowWind_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyContState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyContState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE InflowWind_PackContState SUBROUTINE InflowWind_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -5061,12 +4941,6 @@ SUBROUTINE InflowWind_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_UnPackContState' @@ -5080,8 +4954,8 @@ SUBROUTINE InflowWind_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyContState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyContState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE InflowWind_UnPackContState SUBROUTINE InflowWind_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) @@ -5175,8 +5049,8 @@ SUBROUTINE InflowWind_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyDiscState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyDiscState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE InflowWind_PackDiscState SUBROUTINE InflowWind_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -5192,12 +5066,6 @@ SUBROUTINE InflowWind_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_UnPackDiscState' @@ -5211,8 +5079,8 @@ SUBROUTINE InflowWind_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyDiscState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyDiscState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE InflowWind_UnPackDiscState SUBROUTINE InflowWind_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) @@ -5306,8 +5174,8 @@ SUBROUTINE InflowWind_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyConstrState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE InflowWind_PackConstrState SUBROUTINE InflowWind_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -5323,12 +5191,6 @@ SUBROUTINE InflowWind_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_UnPackConstrState' @@ -5342,8 +5204,8 @@ SUBROUTINE InflowWind_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyConstrState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyConstrState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE InflowWind_UnPackConstrState SUBROUTINE InflowWind_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -5437,8 +5299,8 @@ SUBROUTINE InflowWind_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyOtherState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyOtherState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE InflowWind_PackOtherState SUBROUTINE InflowWind_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -5454,12 +5316,6 @@ SUBROUTINE InflowWind_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_UnPackOtherState' @@ -5473,8 +5329,8 @@ SUBROUTINE InflowWind_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyOtherState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyOtherState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE InflowWind_UnPackOtherState @@ -5552,14 +5408,14 @@ SUBROUTINE InflowWind_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -5572,13 +5428,15 @@ SUBROUTINE InflowWind_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) IF (ALLOCATED(u_out%PositionXYZ) .AND. ALLOCATED(u1%PositionXYZ)) THEN - ALLOCATE(b2(SIZE(u_out%PositionXYZ,1),SIZE(u_out%PositionXYZ,2) )) - ALLOCATE(c2(SIZE(u_out%PositionXYZ,1),SIZE(u_out%PositionXYZ,2) )) - b2 = -(u1%PositionXYZ - u2%PositionXYZ)/t(2) - u_out%PositionXYZ = u1%PositionXYZ + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%PositionXYZ,2),UBOUND(u_out%PositionXYZ,2) + DO i1 = LBOUND(u_out%PositionXYZ,1),UBOUND(u_out%PositionXYZ,1) + b = -(u1%PositionXYZ(i1,i2) - u2%PositionXYZ(i1,i2)) + u_out%PositionXYZ(i1,i2) = u1%PositionXYZ(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated CALL Lidar_Input_ExtrapInterp1( u1%lidar, u2%lidar, tin, u_out%lidar, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) @@ -5611,15 +5469,16 @@ SUBROUTINE InflowWind_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrSt REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -5638,14 +5497,16 @@ SUBROUTINE InflowWind_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrSt CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) IF (ALLOCATED(u_out%PositionXYZ) .AND. ALLOCATED(u1%PositionXYZ)) THEN - ALLOCATE(b2(SIZE(u_out%PositionXYZ,1),SIZE(u_out%PositionXYZ,2) )) - ALLOCATE(c2(SIZE(u_out%PositionXYZ,1),SIZE(u_out%PositionXYZ,2) )) - b2 = (t(3)**2*(u1%PositionXYZ - u2%PositionXYZ) + t(2)**2*(-u1%PositionXYZ + u3%PositionXYZ))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*u1%PositionXYZ + t(3)*u2%PositionXYZ - t(2)*u3%PositionXYZ ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%PositionXYZ = u1%PositionXYZ + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(u_out%PositionXYZ,2),UBOUND(u_out%PositionXYZ,2) + DO i1 = LBOUND(u_out%PositionXYZ,1),UBOUND(u_out%PositionXYZ,1) + b = (t(3)**2*(u1%PositionXYZ(i1,i2) - u2%PositionXYZ(i1,i2)) + t(2)**2*(-u1%PositionXYZ(i1,i2) + u3%PositionXYZ(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*u1%PositionXYZ(i1,i2) + t(3)*u2%PositionXYZ(i1,i2) - t(2)*u3%PositionXYZ(i1,i2) ) * scaleFactor + u_out%PositionXYZ(i1,i2) = u1%PositionXYZ(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated CALL Lidar_Input_ExtrapInterp2( u1%lidar, u2%lidar, u3%lidar, tin, u_out%lidar, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) @@ -5726,14 +5587,14 @@ SUBROUTINE InflowWind_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -5746,28 +5607,26 @@ SUBROUTINE InflowWind_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) IF (ALLOCATED(y_out%VelocityUVW) .AND. ALLOCATED(y1%VelocityUVW)) THEN - ALLOCATE(b2(SIZE(y_out%VelocityUVW,1),SIZE(y_out%VelocityUVW,2) )) - ALLOCATE(c2(SIZE(y_out%VelocityUVW,1),SIZE(y_out%VelocityUVW,2) )) - b2 = -(y1%VelocityUVW - y2%VelocityUVW)/t(2) - y_out%VelocityUVW = y1%VelocityUVW + b2 * t_out - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%VelocityUVW,2),UBOUND(y_out%VelocityUVW,2) + DO i1 = LBOUND(y_out%VelocityUVW,1),UBOUND(y_out%VelocityUVW,1) + b = -(y1%VelocityUVW(i1,i2) - y2%VelocityUVW(i1,i2)) + y_out%VelocityUVW(i1,i2) = y1%VelocityUVW(i1,i2) + b * ScaleFactor + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = -(y1%WriteOutput - y2%WriteOutput)/t(2) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO END IF ! check if allocated - ALLOCATE(b1(SIZE(y_out%DiskVel,1))) - ALLOCATE(c1(SIZE(y_out%DiskVel,1))) - b1 = -(y1%DiskVel - y2%DiskVel)/t(2) - y_out%DiskVel = y1%DiskVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%DiskVel,1),UBOUND(y_out%DiskVel,1) + b = -(y1%DiskVel(i1) - y2%DiskVel(i1)) + y_out%DiskVel(i1) = y1%DiskVel(i1) + b * ScaleFactor + END DO CALL Lidar_Output_ExtrapInterp1( y1%lidar, y2%lidar, tin, y_out%lidar, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE InflowWind_Output_ExtrapInterp1 @@ -5799,15 +5658,16 @@ SUBROUTINE InflowWind_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrS REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'InflowWind_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i02 ! dim2 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays + INTEGER :: i2 ! dim2 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -5826,31 +5686,29 @@ SUBROUTINE InflowWind_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrS CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) IF (ALLOCATED(y_out%VelocityUVW) .AND. ALLOCATED(y1%VelocityUVW)) THEN - ALLOCATE(b2(SIZE(y_out%VelocityUVW,1),SIZE(y_out%VelocityUVW,2) )) - ALLOCATE(c2(SIZE(y_out%VelocityUVW,1),SIZE(y_out%VelocityUVW,2) )) - b2 = (t(3)**2*(y1%VelocityUVW - y2%VelocityUVW) + t(2)**2*(-y1%VelocityUVW + y3%VelocityUVW))/(t(2)*t(3)*(t(2) - t(3))) - c2 = ( (t(2)-t(3))*y1%VelocityUVW + t(3)*y2%VelocityUVW - t(2)*y3%VelocityUVW ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%VelocityUVW = y1%VelocityUVW + b2 * t_out + c2 * t_out**2 - DEALLOCATE(b2) - DEALLOCATE(c2) + DO i2 = LBOUND(y_out%VelocityUVW,2),UBOUND(y_out%VelocityUVW,2) + DO i1 = LBOUND(y_out%VelocityUVW,1),UBOUND(y_out%VelocityUVW,1) + b = (t(3)**2*(y1%VelocityUVW(i1,i2) - y2%VelocityUVW(i1,i2)) + t(2)**2*(-y1%VelocityUVW(i1,i2) + y3%VelocityUVW(i1,i2)))* scaleFactor + c = ( (t(2)-t(3))*y1%VelocityUVW(i1,i2) + t(3)*y2%VelocityUVW(i1,i2) - t(2)*y3%VelocityUVW(i1,i2) ) * scaleFactor + y_out%VelocityUVW(i1,i2) = y1%VelocityUVW(i1,i2) + b + c * t_out + END DO + END DO END IF ! check if allocated IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = (t(3)**2*(y1%WriteOutput - y2%WriteOutput) + t(2)**2*(-y1%WriteOutput + y3%WriteOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WriteOutput + t(3)*y2%WriteOutput - t(2)*y3%WriteOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO END IF ! check if allocated - ALLOCATE(b1(SIZE(y_out%DiskVel,1))) - ALLOCATE(c1(SIZE(y_out%DiskVel,1))) - b1 = (t(3)**2*(y1%DiskVel - y2%DiskVel) + t(2)**2*(-y1%DiskVel + y3%DiskVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%DiskVel + t(3)*y2%DiskVel - t(2)*y3%DiskVel ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%DiskVel = y1%DiskVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%DiskVel,1),UBOUND(y_out%DiskVel,1) + b = (t(3)**2*(y1%DiskVel(i1) - y2%DiskVel(i1)) + t(2)**2*(-y1%DiskVel(i1) + y3%DiskVel(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%DiskVel(i1) + t(3)*y2%DiskVel(i1) - t(2)*y3%DiskVel(i1) ) * scaleFactor + y_out%DiskVel(i1) = y1%DiskVel(i1) + b + c * t_out + END DO CALL Lidar_Output_ExtrapInterp2( y1%lidar, y2%lidar, y3%lidar, tin, y_out%lidar, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE InflowWind_Output_ExtrapInterp2 diff --git a/modules/inflowwind/src/Lidar_Types.f90 b/modules/inflowwind/src/Lidar_Types.f90 index 88981bcf4c..4ec86f6a34 100644 --- a/modules/inflowwind/src/Lidar_Types.f90 +++ b/modules/inflowwind/src/Lidar_Types.f90 @@ -209,18 +209,22 @@ SUBROUTINE Lidar_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%SensorType - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%Tmax - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RotorApexOffsetPos))-1 ) = PACK(InData%RotorApexOffsetPos,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RotorApexOffsetPos) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%HubPosition))-1 ) = PACK(InData%HubPosition,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%HubPosition) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumPulseGate - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%LidRadialVel , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%SensorType + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%Tmax + Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(InData%RotorApexOffsetPos,1), UBOUND(InData%RotorApexOffsetPos,1) + ReKiBuf(Re_Xferred) = InData%RotorApexOffsetPos(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%HubPosition,1), UBOUND(InData%HubPosition,1) + ReKiBuf(Re_Xferred) = InData%HubPosition(i1) + Re_Xferred = Re_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%NumPulseGate + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%LidRadialVel, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Lidar_PackInitInput SUBROUTINE Lidar_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -236,12 +240,6 @@ SUBROUTINE Lidar_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -256,36 +254,26 @@ SUBROUTINE Lidar_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%SensorType = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%Tmax = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%SensorType = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%Tmax = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 i1_l = LBOUND(OutData%RotorApexOffsetPos,1) i1_u = UBOUND(OutData%RotorApexOffsetPos,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%RotorApexOffsetPos = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RotorApexOffsetPos))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RotorApexOffsetPos) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%RotorApexOffsetPos,1), UBOUND(OutData%RotorApexOffsetPos,1) + OutData%RotorApexOffsetPos(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%HubPosition,1) i1_u = UBOUND(OutData%HubPosition,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%HubPosition = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%HubPosition))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%HubPosition) - DEALLOCATE(mask1) - OutData%NumPulseGate = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%LidRadialVel = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%HubPosition,1), UBOUND(OutData%HubPosition,1) + OutData%HubPosition(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%NumPulseGate = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%LidRadialVel = TRANSFER(IntKiBuf(Int_Xferred), OutData%LidRadialVel) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Lidar_UnPackInitInput SUBROUTINE Lidar_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -379,8 +367,8 @@ SUBROUTINE Lidar_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyInitOut - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyInitOut + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Lidar_PackInitOutput SUBROUTINE Lidar_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -396,12 +384,6 @@ SUBROUTINE Lidar_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_UnPackInitOutput' @@ -415,8 +397,8 @@ SUBROUTINE Lidar_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyInitOut = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyInitOut = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Lidar_UnPackInitOutput SUBROUTINE Lidar_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -531,28 +513,30 @@ SUBROUTINE Lidar_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumPulseGate - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RotorApexOffsetPos))-1 ) = PACK(InData%RotorApexOffsetPos,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RotorApexOffsetPos) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RayRangeSq - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SpatialRes - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%SensorType - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WtFnTrunc - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PulseRangeOne - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DeltaP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DeltaR - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%r_p - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%LidRadialVel , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumPulseGate + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%RotorApexOffsetPos,1), UBOUND(InData%RotorApexOffsetPos,1) + ReKiBuf(Re_Xferred) = InData%RotorApexOffsetPos(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%RayRangeSq + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SpatialRes + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%SensorType + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtFnTrunc + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PulseRangeOne + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DeltaP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DeltaR + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%r_p + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%LidRadialVel, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Lidar_PackParam SUBROUTINE Lidar_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -568,12 +552,6 @@ SUBROUTINE Lidar_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -588,37 +566,32 @@ SUBROUTINE Lidar_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%NumPulseGate = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NumPulseGate = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%RotorApexOffsetPos,1) i1_u = UBOUND(OutData%RotorApexOffsetPos,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%RotorApexOffsetPos = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RotorApexOffsetPos))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RotorApexOffsetPos) - DEALLOCATE(mask1) - OutData%RayRangeSq = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SpatialRes = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SensorType = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%WtFnTrunc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PulseRangeOne = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%DeltaP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%DeltaR = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%r_p = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%LidRadialVel = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%RotorApexOffsetPos,1), UBOUND(OutData%RotorApexOffsetPos,1) + OutData%RotorApexOffsetPos(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%RayRangeSq = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SpatialRes = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SensorType = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WtFnTrunc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PulseRangeOne = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%DeltaP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%DeltaR = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%r_p = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LidRadialVel = TRANSFER(IntKiBuf(Int_Xferred), OutData%LidRadialVel) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE Lidar_UnPackParam SUBROUTINE Lidar_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) @@ -712,8 +685,8 @@ SUBROUTINE Lidar_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyContState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyContState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Lidar_PackContState SUBROUTINE Lidar_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -729,12 +702,6 @@ SUBROUTINE Lidar_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_UnPackContState' @@ -748,8 +715,8 @@ SUBROUTINE Lidar_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyContState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyContState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Lidar_UnPackContState SUBROUTINE Lidar_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) @@ -843,8 +810,8 @@ SUBROUTINE Lidar_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyDiscState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyDiscState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Lidar_PackDiscState SUBROUTINE Lidar_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -860,12 +827,6 @@ SUBROUTINE Lidar_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_UnPackDiscState' @@ -879,8 +840,8 @@ SUBROUTINE Lidar_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyDiscState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyDiscState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Lidar_UnPackDiscState SUBROUTINE Lidar_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) @@ -974,8 +935,8 @@ SUBROUTINE Lidar_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyConstrState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Lidar_PackConstrState SUBROUTINE Lidar_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -991,12 +952,6 @@ SUBROUTINE Lidar_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_UnPackConstrState' @@ -1010,8 +965,8 @@ SUBROUTINE Lidar_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyConstrState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyConstrState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Lidar_UnPackConstrState SUBROUTINE Lidar_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -1105,8 +1060,8 @@ SUBROUTINE Lidar_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyOtherState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyOtherState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Lidar_PackOtherState SUBROUTINE Lidar_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1122,12 +1077,6 @@ SUBROUTINE Lidar_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_UnPackOtherState' @@ -1141,8 +1090,8 @@ SUBROUTINE Lidar_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyOtherState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyOtherState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Lidar_UnPackOtherState SUBROUTINE Lidar_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) @@ -1236,8 +1185,8 @@ SUBROUTINE Lidar_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyMiscVar - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyMiscVar + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Lidar_PackMisc SUBROUTINE Lidar_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1253,12 +1202,6 @@ SUBROUTINE Lidar_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_UnPackMisc' @@ -1272,8 +1215,8 @@ SUBROUTINE Lidar_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyMiscVar = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyMiscVar = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Lidar_UnPackMisc SUBROUTINE Lidar_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -1374,14 +1317,18 @@ SUBROUTINE Lidar_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LidPosition))-1 ) = PACK(InData%LidPosition,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LidPosition) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MsrPosition))-1 ) = PACK(InData%MsrPosition,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MsrPosition) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PulseLidEl - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PulseLidAz - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%LidPosition,1), UBOUND(InData%LidPosition,1) + ReKiBuf(Re_Xferred) = InData%LidPosition(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%MsrPosition,1), UBOUND(InData%MsrPosition,1) + ReKiBuf(Re_Xferred) = InData%MsrPosition(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%PulseLidEl + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PulseLidAz + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Lidar_PackInput SUBROUTINE Lidar_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1397,12 +1344,6 @@ SUBROUTINE Lidar_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1419,30 +1360,20 @@ SUBROUTINE Lidar_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM Int_Xferred = 1 i1_l = LBOUND(OutData%LidPosition,1) i1_u = UBOUND(OutData%LidPosition,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%LidPosition = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LidPosition))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LidPosition) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LidPosition,1), UBOUND(OutData%LidPosition,1) + OutData%LidPosition(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%MsrPosition,1) i1_u = UBOUND(OutData%MsrPosition,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%MsrPosition = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MsrPosition))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%MsrPosition) - DEALLOCATE(mask1) - OutData%PulseLidEl = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PulseLidAz = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%MsrPosition,1), UBOUND(OutData%MsrPosition,1) + OutData%MsrPosition(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%PulseLidEl = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PulseLidAz = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Lidar_UnPackInput SUBROUTINE Lidar_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -1585,8 +1516,10 @@ SUBROUTINE Lidar_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LidSpeed,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LidSpeed)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LidSpeed))-1 ) = PACK(InData%LidSpeed,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LidSpeed) + DO i1 = LBOUND(InData%LidSpeed,1), UBOUND(InData%LidSpeed,1) + ReKiBuf(Re_Xferred) = InData%LidSpeed(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WtTrunc) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1598,8 +1531,10 @@ SUBROUTINE Lidar_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WtTrunc,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WtTrunc)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WtTrunc))-1 ) = PACK(InData%WtTrunc,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WtTrunc) + DO i1 = LBOUND(InData%WtTrunc,1), UBOUND(InData%WtTrunc,1) + ReKiBuf(Re_Xferred) = InData%WtTrunc(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE Lidar_PackOutput @@ -1616,12 +1551,6 @@ SUBROUTINE Lidar_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1649,15 +1578,10 @@ SUBROUTINE Lidar_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LidSpeed.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LidSpeed)>0) OutData%LidSpeed = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LidSpeed))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LidSpeed) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LidSpeed,1), UBOUND(OutData%LidSpeed,1) + OutData%LidSpeed(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WtTrunc not allocated Int_Xferred = Int_Xferred + 1 @@ -1672,15 +1596,10 @@ SUBROUTINE Lidar_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WtTrunc.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WtTrunc)>0) OutData%WtTrunc = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WtTrunc))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WtTrunc) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WtTrunc,1), UBOUND(OutData%WtTrunc,1) + OutData%WtTrunc(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE Lidar_UnPackOutput @@ -1759,12 +1678,12 @@ SUBROUTINE Lidar_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMs REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -1777,22 +1696,20 @@ SUBROUTINE Lidar_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(b1(SIZE(u_out%LidPosition,1))) - ALLOCATE(c1(SIZE(u_out%LidPosition,1))) - b1 = -(u1%LidPosition - u2%LidPosition)/t(2) - u_out%LidPosition = u1%LidPosition + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%MsrPosition,1))) - ALLOCATE(c1(SIZE(u_out%MsrPosition,1))) - b1 = -(u1%MsrPosition - u2%MsrPosition)/t(2) - u_out%MsrPosition = u1%MsrPosition + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - b0 = -(u1%PulseLidEl - u2%PulseLidEl)/t(2) - u_out%PulseLidEl = u1%PulseLidEl + b0 * t_out - b0 = -(u1%PulseLidAz - u2%PulseLidAz)/t(2) - u_out%PulseLidAz = u1%PulseLidAz + b0 * t_out + + ScaleFactor = t_out / t(2) + DO i1 = LBOUND(u_out%LidPosition,1),UBOUND(u_out%LidPosition,1) + b = -(u1%LidPosition(i1) - u2%LidPosition(i1)) + u_out%LidPosition(i1) = u1%LidPosition(i1) + b * ScaleFactor + END DO + DO i1 = LBOUND(u_out%MsrPosition,1),UBOUND(u_out%MsrPosition,1) + b = -(u1%MsrPosition(i1) - u2%MsrPosition(i1)) + u_out%MsrPosition(i1) = u1%MsrPosition(i1) + b * ScaleFactor + END DO + b = -(u1%PulseLidEl - u2%PulseLidEl) + u_out%PulseLidEl = u1%PulseLidEl + b * ScaleFactor + b = -(u1%PulseLidAz - u2%PulseLidAz) + u_out%PulseLidAz = u1%PulseLidAz + b * ScaleFactor END SUBROUTINE Lidar_Input_ExtrapInterp1 @@ -1822,13 +1739,14 @@ SUBROUTINE Lidar_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, E REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -1847,26 +1765,24 @@ SUBROUTINE Lidar_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, E CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(b1(SIZE(u_out%LidPosition,1))) - ALLOCATE(c1(SIZE(u_out%LidPosition,1))) - b1 = (t(3)**2*(u1%LidPosition - u2%LidPosition) + t(2)**2*(-u1%LidPosition + u3%LidPosition))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%LidPosition + t(3)*u2%LidPosition - t(2)*u3%LidPosition ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%LidPosition = u1%LidPosition + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - ALLOCATE(b1(SIZE(u_out%MsrPosition,1))) - ALLOCATE(c1(SIZE(u_out%MsrPosition,1))) - b1 = (t(3)**2*(u1%MsrPosition - u2%MsrPosition) + t(2)**2*(-u1%MsrPosition + u3%MsrPosition))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%MsrPosition + t(3)*u2%MsrPosition - t(2)*u3%MsrPosition ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%MsrPosition = u1%MsrPosition + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - b0 = (t(3)**2*(u1%PulseLidEl - u2%PulseLidEl) + t(2)**2*(-u1%PulseLidEl + u3%PulseLidEl))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%PulseLidEl + t(3)*u2%PulseLidEl - t(2)*u3%PulseLidEl ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%PulseLidEl = u1%PulseLidEl + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%PulseLidAz - u2%PulseLidAz) + t(2)**2*(-u1%PulseLidAz + u3%PulseLidAz))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%PulseLidAz + t(3)*u2%PulseLidAz - t(2)*u3%PulseLidAz ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%PulseLidAz = u1%PulseLidAz + b0 * t_out + c0 * t_out**2 + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) + DO i1 = LBOUND(u_out%LidPosition,1),UBOUND(u_out%LidPosition,1) + b = (t(3)**2*(u1%LidPosition(i1) - u2%LidPosition(i1)) + t(2)**2*(-u1%LidPosition(i1) + u3%LidPosition(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%LidPosition(i1) + t(3)*u2%LidPosition(i1) - t(2)*u3%LidPosition(i1) ) * scaleFactor + u_out%LidPosition(i1) = u1%LidPosition(i1) + b + c * t_out + END DO + DO i1 = LBOUND(u_out%MsrPosition,1),UBOUND(u_out%MsrPosition,1) + b = (t(3)**2*(u1%MsrPosition(i1) - u2%MsrPosition(i1)) + t(2)**2*(-u1%MsrPosition(i1) + u3%MsrPosition(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%MsrPosition(i1) + t(3)*u2%MsrPosition(i1) - t(2)*u3%MsrPosition(i1) ) * scaleFactor + u_out%MsrPosition(i1) = u1%MsrPosition(i1) + b + c * t_out + END DO + b = (t(3)**2*(u1%PulseLidEl - u2%PulseLidEl) + t(2)**2*(-u1%PulseLidEl + u3%PulseLidEl))* scaleFactor + c = ( (t(2)-t(3))*u1%PulseLidEl + t(3)*u2%PulseLidEl - t(2)*u3%PulseLidEl ) * scaleFactor + u_out%PulseLidEl = u1%PulseLidEl + b + c * t_out + b = (t(3)**2*(u1%PulseLidAz - u2%PulseLidAz) + t(2)**2*(-u1%PulseLidAz + u3%PulseLidAz))* scaleFactor + c = ( (t(2)-t(3))*u1%PulseLidAz + t(3)*u2%PulseLidAz - t(2)*u3%PulseLidAz ) * scaleFactor + u_out%PulseLidAz = u1%PulseLidAz + b + c * t_out END SUBROUTINE Lidar_Input_ExtrapInterp2 @@ -1944,12 +1860,12 @@ SUBROUTINE Lidar_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrM REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -1962,21 +1878,19 @@ SUBROUTINE Lidar_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) IF (ALLOCATED(y_out%LidSpeed) .AND. ALLOCATED(y1%LidSpeed)) THEN - ALLOCATE(b1(SIZE(y_out%LidSpeed,1))) - ALLOCATE(c1(SIZE(y_out%LidSpeed,1))) - b1 = -(y1%LidSpeed - y2%LidSpeed)/t(2) - y_out%LidSpeed = y1%LidSpeed + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%LidSpeed,1),UBOUND(y_out%LidSpeed,1) + b = -(y1%LidSpeed(i1) - y2%LidSpeed(i1)) + y_out%LidSpeed(i1) = y1%LidSpeed(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ALLOCATED(y_out%WtTrunc) .AND. ALLOCATED(y1%WtTrunc)) THEN - ALLOCATE(b1(SIZE(y_out%WtTrunc,1))) - ALLOCATE(c1(SIZE(y_out%WtTrunc,1))) - b1 = -(y1%WtTrunc - y2%WtTrunc)/t(2) - y_out%WtTrunc = y1%WtTrunc + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WtTrunc,1),UBOUND(y_out%WtTrunc,1) + b = -(y1%WtTrunc(i1) - y2%WtTrunc(i1)) + y_out%WtTrunc(i1) = y1%WtTrunc(i1) + b * ScaleFactor + END DO END IF ! check if allocated END SUBROUTINE Lidar_Output_ExtrapInterp1 @@ -2007,13 +1921,14 @@ SUBROUTINE Lidar_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'Lidar_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -2032,23 +1947,21 @@ SUBROUTINE Lidar_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) IF (ALLOCATED(y_out%LidSpeed) .AND. ALLOCATED(y1%LidSpeed)) THEN - ALLOCATE(b1(SIZE(y_out%LidSpeed,1))) - ALLOCATE(c1(SIZE(y_out%LidSpeed,1))) - b1 = (t(3)**2*(y1%LidSpeed - y2%LidSpeed) + t(2)**2*(-y1%LidSpeed + y3%LidSpeed))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%LidSpeed + t(3)*y2%LidSpeed - t(2)*y3%LidSpeed ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%LidSpeed = y1%LidSpeed + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%LidSpeed,1),UBOUND(y_out%LidSpeed,1) + b = (t(3)**2*(y1%LidSpeed(i1) - y2%LidSpeed(i1)) + t(2)**2*(-y1%LidSpeed(i1) + y3%LidSpeed(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%LidSpeed(i1) + t(3)*y2%LidSpeed(i1) - t(2)*y3%LidSpeed(i1) ) * scaleFactor + y_out%LidSpeed(i1) = y1%LidSpeed(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ALLOCATED(y_out%WtTrunc) .AND. ALLOCATED(y1%WtTrunc)) THEN - ALLOCATE(b1(SIZE(y_out%WtTrunc,1))) - ALLOCATE(c1(SIZE(y_out%WtTrunc,1))) - b1 = (t(3)**2*(y1%WtTrunc - y2%WtTrunc) + t(2)**2*(-y1%WtTrunc + y3%WtTrunc))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WtTrunc + t(3)*y2%WtTrunc - t(2)*y3%WtTrunc ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WtTrunc = y1%WtTrunc + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WtTrunc,1),UBOUND(y_out%WtTrunc,1) + b = (t(3)**2*(y1%WtTrunc(i1) - y2%WtTrunc(i1)) + t(2)**2*(-y1%WtTrunc(i1) + y3%WtTrunc(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WtTrunc(i1) + t(3)*y2%WtTrunc(i1) - t(2)*y3%WtTrunc(i1) ) * scaleFactor + y_out%WtTrunc(i1) = y1%WtTrunc(i1) + b + c * t_out + END DO END IF ! check if allocated END SUBROUTINE Lidar_Output_ExtrapInterp2 diff --git a/modules/map/src/MAP_Fortran_Types.f90 b/modules/map/src/MAP_Fortran_Types.f90 index f20c4687cc..47c34ab7c1 100644 --- a/modules/map/src/MAP_Fortran_Types.f90 +++ b/modules/map/src/MAP_Fortran_Types.f90 @@ -146,8 +146,8 @@ SUBROUTINE MAP_Fortran_PackLin_InitInputType( ReKiBuf, DbKiBuf, IntKiBuf, Indata Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%linearize , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%linearize, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE MAP_Fortran_PackLin_InitInputType SUBROUTINE MAP_Fortran_UnPackLin_InitInputType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -163,12 +163,6 @@ SUBROUTINE MAP_Fortran_UnPackLin_InitInputType( ReKiBuf, DbKiBuf, IntKiBuf, Outd INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -184,8 +178,8 @@ SUBROUTINE MAP_Fortran_UnPackLin_InitInputType( ReKiBuf, DbKiBuf, IntKiBuf, Outd Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%linearize = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%linearize) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE MAP_Fortran_UnPackLin_InitInputType SUBROUTINE MAP_Fortran_CopyLin_InitOutputType( SrcLin_InitOutputTypeData, DstLin_InitOutputTypeData, CtrlCode, ErrStat, ErrMsg ) @@ -348,12 +342,12 @@ SUBROUTINE MAP_Fortran_PackLin_InitOutputType( ReKiBuf, DbKiBuf, IntKiBuf, Indat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_y,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%LinNames_y,1), UBOUND(InData%LinNames_y,1) + DO 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LinNames_u) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -365,12 +359,12 @@ SUBROUTINE MAP_Fortran_PackLin_InitOutputType( ReKiBuf, DbKiBuf, IntKiBuf, Indat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_u,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%LinNames_u,1), UBOUND(InData%LinNames_u,1) + DO 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%IsLoad_u) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -382,8 +376,10 @@ SUBROUTINE MAP_Fortran_PackLin_InitOutputType( ReKiBuf, DbKiBuf, IntKiBuf, Indat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IsLoad_u,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%IsLoad_u)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%IsLoad_u)-1 ) = TRANSFER(PACK( InData%IsLoad_u ,.TRUE.), IntKiBuf(1), SIZE(InData%IsLoad_u)) - Int_Xferred = Int_Xferred + SIZE(InData%IsLoad_u) + DO i1 = LBOUND(InData%IsLoad_u,1), UBOUND(InData%IsLoad_u,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%IsLoad_u(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF END SUBROUTINE MAP_Fortran_PackLin_InitOutputType @@ -400,12 +396,6 @@ SUBROUTINE MAP_Fortran_UnPackLin_InitOutputType( ReKiBuf, DbKiBuf, IntKiBuf, Out INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -433,19 +423,12 @@ SUBROUTINE MAP_Fortran_UnPackLin_InitOutputType( ReKiBuf, DbKiBuf, IntKiBuf, Out CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%LinNames_y,1), UBOUND(OutData%LinNames_y,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_u not allocated Int_Xferred = Int_Xferred + 1 @@ -460,19 +443,12 @@ SUBROUTINE MAP_Fortran_UnPackLin_InitOutputType( ReKiBuf, DbKiBuf, IntKiBuf, Out CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%LinNames_u,1), UBOUND(OutData%LinNames_u,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IsLoad_u not allocated Int_Xferred = Int_Xferred + 1 @@ -487,15 +463,10 @@ SUBROUTINE MAP_Fortran_UnPackLin_InitOutputType( ReKiBuf, DbKiBuf, IntKiBuf, Out CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%IsLoad_u)>0) OutData%IsLoad_u = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%IsLoad_u))-1 ), OutData%IsLoad_u), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%IsLoad_u) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%IsLoad_u,1), UBOUND(OutData%IsLoad_u,1) + OutData%IsLoad_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsLoad_u(i1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF END SUBROUTINE MAP_Fortran_UnPackLin_InitOutputType @@ -629,13 +600,17 @@ SUBROUTINE MAP_Fortran_PackLin_ParamType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Jac_u_indx)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%Jac_u_indx))-1 ) = PACK(InData%Jac_u_indx,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%Jac_u_indx) + DO i2 = LBOUND(InData%Jac_u_indx,2), UBOUND(InData%Jac_u_indx,2) + DO i1 = LBOUND(InData%Jac_u_indx,1), UBOUND(InData%Jac_u_indx,1) + IntKiBuf(Int_Xferred) = InData%Jac_u_indx(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%du - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Jac_ny - Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%du + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Jac_ny + Int_Xferred = Int_Xferred + 1 END SUBROUTINE MAP_Fortran_PackLin_ParamType SUBROUTINE MAP_Fortran_UnPackLin_ParamType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -651,12 +626,6 @@ SUBROUTINE MAP_Fortran_UnPackLin_ParamType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -688,20 +657,17 @@ SUBROUTINE MAP_Fortran_UnPackLin_ParamType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Jac_u_indx)>0) OutData%Jac_u_indx = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%Jac_u_indx))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%Jac_u_indx) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Jac_u_indx,2), UBOUND(OutData%Jac_u_indx,2) + DO i1 = LBOUND(OutData%Jac_u_indx,1), UBOUND(OutData%Jac_u_indx,1) + OutData%Jac_u_indx(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF - OutData%du = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 - OutData%Jac_ny = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%du = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%Jac_ny = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE MAP_Fortran_UnPackLin_ParamType END MODULE MAP_Fortran_Types diff --git a/modules/map/src/MAP_Types.f90 b/modules/map/src/MAP_Types.f90 index f72e25ddf5..1b15b8f331 100644 --- a/modules/map/src/MAP_Types.f90 +++ b/modules/map/src/MAP_Types.f90 @@ -388,36 +388,36 @@ SUBROUTINE MAP_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%gravity - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%sea_density - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%depth - Db_Xferred = Db_Xferred + 1 - DO I = 1, LEN(InData%file_name) - IntKiBuf(Int_Xferred) = ICHAR(InData%file_name(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%summary_file_name) - IntKiBuf(Int_Xferred) = ICHAR(InData%summary_file_name(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%library_input_str) - IntKiBuf(Int_Xferred) = ICHAR(InData%library_input_str(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%node_input_str) - IntKiBuf(Int_Xferred) = ICHAR(InData%node_input_str(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%line_input_str) - IntKiBuf(Int_Xferred) = ICHAR(InData%line_input_str(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%option_input_str) - IntKiBuf(Int_Xferred) = ICHAR(InData%option_input_str(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DbKiBuf(Db_Xferred) = InData%gravity + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%sea_density + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%depth + Db_Xferred = Db_Xferred + 1 + DO I = 1, LEN(InData%file_name) + IntKiBuf(Int_Xferred) = ICHAR(InData%file_name(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%summary_file_name) + IntKiBuf(Int_Xferred) = ICHAR(InData%summary_file_name(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%library_input_str) + IntKiBuf(Int_Xferred) = ICHAR(InData%library_input_str(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%node_input_str) + IntKiBuf(Int_Xferred) = ICHAR(InData%node_input_str(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%line_input_str) + IntKiBuf(Int_Xferred) = ICHAR(InData%line_input_str(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%option_input_str) + IntKiBuf(Int_Xferred) = ICHAR(InData%option_input_str(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I CALL MAP_Fortran_Packlin_initinputtype( Re_Buf, Db_Buf, Int_Buf, InData%LinInitInp, ErrStat2, ErrMsg2, OnlySize ) ! LinInitInp CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -461,12 +461,6 @@ SUBROUTINE MAP_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -481,44 +475,44 @@ SUBROUTINE MAP_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%gravity = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%gravity = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 OutData%C_obj%gravity = OutData%gravity - OutData%sea_density = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%sea_density = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 OutData%C_obj%sea_density = OutData%sea_density - OutData%depth = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%depth = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 OutData%C_obj%depth = OutData%depth - DO I = 1, LEN(OutData%file_name) - OutData%file_name(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%file_name) + OutData%file_name(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I OutData%C_obj%file_name = TRANSFER(OutData%file_name, OutData%C_obj%file_name ) - DO I = 1, LEN(OutData%summary_file_name) - OutData%summary_file_name(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%summary_file_name) + OutData%summary_file_name(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I OutData%C_obj%summary_file_name = TRANSFER(OutData%summary_file_name, OutData%C_obj%summary_file_name ) - DO I = 1, LEN(OutData%library_input_str) - OutData%library_input_str(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%library_input_str) + OutData%library_input_str(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I OutData%C_obj%library_input_str = TRANSFER(OutData%library_input_str, OutData%C_obj%library_input_str ) - DO I = 1, LEN(OutData%node_input_str) - OutData%node_input_str(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%node_input_str) + OutData%node_input_str(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I OutData%C_obj%node_input_str = TRANSFER(OutData%node_input_str, OutData%C_obj%node_input_str ) - DO I = 1, LEN(OutData%line_input_str) - OutData%line_input_str(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%line_input_str) + OutData%line_input_str(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I OutData%C_obj%line_input_str = TRANSFER(OutData%line_input_str, OutData%C_obj%line_input_str ) - DO I = 1, LEN(OutData%option_input_str) - OutData%option_input_str(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%option_input_str) + OutData%option_input_str(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I OutData%C_obj%option_input_str = TRANSFER(OutData%option_input_str, OutData%C_obj%option_input_str ) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -562,13 +556,21 @@ SUBROUTINE MAP_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END SUBROUTINE MAP_UnPackInitInput - SUBROUTINE MAP_C2Fary_CopyInitInput( InitInputData, ErrStat, ErrMsg ) + SUBROUTINE MAP_C2Fary_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers ) TYPE(MAP_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF InitInputData%gravity = InitInputData%C_obj%gravity InitInputData%sea_density = InitInputData%C_obj%sea_density InitInputData%depth = InitInputData%C_obj%depth @@ -580,6 +582,32 @@ SUBROUTINE MAP_C2Fary_CopyInitInput( InitInputData, ErrStat, ErrMsg ) InitInputData%option_input_str = TRANSFER(InitInputData%C_obj%option_input_str, InitInputData%option_input_str ) END SUBROUTINE MAP_C2Fary_CopyInitInput + SUBROUTINE MAP_F2C_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(MAP_InitInputType), INTENT(INOUT) :: InitInputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + InitInputData%C_obj%gravity = InitInputData%gravity + InitInputData%C_obj%sea_density = InitInputData%sea_density + InitInputData%C_obj%depth = InitInputData%depth + InitInputData%C_obj%file_name = TRANSFER(InitInputData%file_name, InitInputData%C_obj%file_name ) + InitInputData%C_obj%summary_file_name = TRANSFER(InitInputData%summary_file_name, InitInputData%C_obj%summary_file_name ) + InitInputData%C_obj%library_input_str = TRANSFER(InitInputData%library_input_str, InitInputData%C_obj%library_input_str ) + InitInputData%C_obj%node_input_str = TRANSFER(InitInputData%node_input_str, InitInputData%C_obj%node_input_str ) + InitInputData%C_obj%line_input_str = TRANSFER(InitInputData%line_input_str, InitInputData%C_obj%line_input_str ) + InitInputData%C_obj%option_input_str = TRANSFER(InitInputData%option_input_str, InitInputData%C_obj%option_input_str ) + END SUBROUTINE MAP_F2C_CopyInitInput + SUBROUTINE MAP_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(MAP_InitOutputType), INTENT(IN) :: SrcInitOutputData TYPE(MAP_InitOutputType), INTENT(INOUT) :: DstInitOutputData @@ -764,18 +792,18 @@ SUBROUTINE MAP_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%progName) - IntKiBuf(Int_Xferred) = ICHAR(InData%progName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%version) - IntKiBuf(Int_Xferred) = ICHAR(InData%version(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%compilingData) - IntKiBuf(Int_Xferred) = ICHAR(InData%compilingData(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(InData%progName) + IntKiBuf(Int_Xferred) = ICHAR(InData%progName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%version) + IntKiBuf(Int_Xferred) = ICHAR(InData%version(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%compilingData) + IntKiBuf(Int_Xferred) = ICHAR(InData%compilingData(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( .NOT. ALLOCATED(InData%writeOutputHdr) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -786,12 +814,12 @@ SUBROUTINE MAP_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%writeOutputHdr,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%writeOutputHdr,1), UBOUND(InData%writeOutputHdr,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%writeOutputUnt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -803,12 +831,12 @@ SUBROUTINE MAP_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%writeOutputUnt,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%writeOutputUnt,1), UBOUND(InData%writeOutputUnt,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + 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) @@ -881,12 +909,6 @@ SUBROUTINE MAP_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -901,20 +923,20 @@ SUBROUTINE MAP_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%progName) - OutData%progName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%progName) + OutData%progName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I OutData%C_obj%progName = TRANSFER(OutData%progName, OutData%C_obj%progName ) - DO I = 1, LEN(OutData%version) - OutData%version(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%version) + OutData%version(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I OutData%C_obj%version = TRANSFER(OutData%version, OutData%C_obj%version ) - DO I = 1, LEN(OutData%compilingData) - OutData%compilingData(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%compilingData) + OutData%compilingData(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I OutData%C_obj%compilingData = TRANSFER(OutData%compilingData, OutData%C_obj%compilingData ) IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! writeOutputHdr not allocated Int_Xferred = Int_Xferred + 1 @@ -929,19 +951,12 @@ SUBROUTINE MAP_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%writeOutputHdr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%writeOutputHdr,1), UBOUND(OutData%writeOutputHdr,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! writeOutputUnt not allocated Int_Xferred = Int_Xferred + 1 @@ -956,19 +971,12 @@ SUBROUTINE MAP_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%writeOutputUnt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%writeOutputUnt,1), UBOUND(OutData%writeOutputUnt,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -1052,18 +1060,46 @@ SUBROUTINE MAP_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END SUBROUTINE MAP_UnPackInitOutput - SUBROUTINE MAP_C2Fary_CopyInitOutput( InitOutputData, ErrStat, ErrMsg ) + SUBROUTINE MAP_C2Fary_CopyInitOutput( InitOutputData, ErrStat, ErrMsg, SkipPointers ) TYPE(MAP_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF InitOutputData%progName = TRANSFER(InitOutputData%C_obj%progName, InitOutputData%progName ) InitOutputData%version = TRANSFER(InitOutputData%C_obj%version, InitOutputData%version ) InitOutputData%compilingData = TRANSFER(InitOutputData%C_obj%compilingData, InitOutputData%compilingData ) END SUBROUTINE MAP_C2Fary_CopyInitOutput + SUBROUTINE MAP_F2C_CopyInitOutput( InitOutputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(MAP_InitOutputType), INTENT(INOUT) :: InitOutputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + InitOutputData%C_obj%progName = TRANSFER(InitOutputData%progName, InitOutputData%C_obj%progName ) + InitOutputData%C_obj%version = TRANSFER(InitOutputData%version, InitOutputData%C_obj%version ) + InitOutputData%C_obj%compilingData = TRANSFER(InitOutputData%compilingData, InitOutputData%C_obj%compilingData ) + END SUBROUTINE MAP_F2C_CopyInitOutput + SUBROUTINE MAP_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(MAP_ContinuousStateType), INTENT(IN) :: SrcContStateData TYPE(MAP_ContinuousStateType), INTENT(INOUT) :: DstContStateData @@ -1158,8 +1194,8 @@ SUBROUTINE MAP_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%dummy - Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%dummy + Db_Xferred = Db_Xferred + 1 END SUBROUTINE MAP_PackContState SUBROUTINE MAP_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1175,12 +1211,6 @@ SUBROUTINE MAP_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'MAP_UnPackContState' @@ -1194,21 +1224,47 @@ SUBROUTINE MAP_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%dummy = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%dummy = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 OutData%C_obj%dummy = OutData%dummy END SUBROUTINE MAP_UnPackContState - SUBROUTINE MAP_C2Fary_CopyContState( ContStateData, ErrStat, ErrMsg ) + SUBROUTINE MAP_C2Fary_CopyContState( ContStateData, ErrStat, ErrMsg, SkipPointers ) TYPE(MAP_ContinuousStateType), INTENT(INOUT) :: ContStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF ContStateData%dummy = ContStateData%C_obj%dummy END SUBROUTINE MAP_C2Fary_CopyContState + SUBROUTINE MAP_F2C_CopyContState( ContStateData, ErrStat, ErrMsg, SkipPointers ) + TYPE(MAP_ContinuousStateType), INTENT(INOUT) :: ContStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + ContStateData%C_obj%dummy = ContStateData%dummy + END SUBROUTINE MAP_F2C_CopyContState + SUBROUTINE MAP_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(MAP_DiscreteStateType), INTENT(IN) :: SrcDiscStateData TYPE(MAP_DiscreteStateType), INTENT(INOUT) :: DstDiscStateData @@ -1303,8 +1359,8 @@ SUBROUTINE MAP_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%dummy - Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%dummy + Db_Xferred = Db_Xferred + 1 END SUBROUTINE MAP_PackDiscState SUBROUTINE MAP_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1320,12 +1376,6 @@ SUBROUTINE MAP_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'MAP_UnPackDiscState' @@ -1339,21 +1389,47 @@ SUBROUTINE MAP_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%dummy = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%dummy = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 OutData%C_obj%dummy = OutData%dummy END SUBROUTINE MAP_UnPackDiscState - SUBROUTINE MAP_C2Fary_CopyDiscState( DiscStateData, ErrStat, ErrMsg ) + SUBROUTINE MAP_C2Fary_CopyDiscState( DiscStateData, ErrStat, ErrMsg, SkipPointers ) TYPE(MAP_DiscreteStateType), INTENT(INOUT) :: DiscStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF DiscStateData%dummy = DiscStateData%C_obj%dummy END SUBROUTINE MAP_C2Fary_CopyDiscState + SUBROUTINE MAP_F2C_CopyDiscState( DiscStateData, ErrStat, ErrMsg, SkipPointers ) + TYPE(MAP_DiscreteStateType), INTENT(INOUT) :: DiscStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + DiscStateData%C_obj%dummy = DiscStateData%dummy + END SUBROUTINE MAP_F2C_CopyDiscState + SUBROUTINE MAP_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(MAP_OtherStateType), INTENT(IN) :: SrcOtherStateData TYPE(MAP_OtherStateType), INTENT(INOUT) :: DstOtherStateData @@ -1872,8 +1948,10 @@ SUBROUTINE MAP_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%H,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%H)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%H))-1 ) = PACK(InData%H,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%H) + DO i1 = LBOUND(InData%H,1), UBOUND(InData%H,1) + DbKiBuf(Db_Xferred) = InData%H(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%V) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1885,8 +1963,10 @@ SUBROUTINE MAP_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%V,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%V)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%V))-1 ) = PACK(InData%V,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%V) + DO i1 = LBOUND(InData%V,1), UBOUND(InData%V,1) + DbKiBuf(Db_Xferred) = InData%V(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%Ha) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1898,8 +1978,10 @@ SUBROUTINE MAP_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ha,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Ha)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Ha))-1 ) = PACK(InData%Ha,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Ha) + DO i1 = LBOUND(InData%Ha,1), UBOUND(InData%Ha,1) + DbKiBuf(Db_Xferred) = InData%Ha(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%Va) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1911,8 +1993,10 @@ SUBROUTINE MAP_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Va,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Va)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Va))-1 ) = PACK(InData%Va,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Va) + DO i1 = LBOUND(InData%Va,1), UBOUND(InData%Va,1) + DbKiBuf(Db_Xferred) = InData%Va(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%x) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1924,8 +2008,10 @@ SUBROUTINE MAP_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%x)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%x))-1 ) = PACK(InData%x,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%x) + DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) + DbKiBuf(Db_Xferred) = InData%x(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%y) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1937,8 +2023,10 @@ SUBROUTINE MAP_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%y)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%y))-1 ) = PACK(InData%y,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%y) + DO i1 = LBOUND(InData%y,1), UBOUND(InData%y,1) + DbKiBuf(Db_Xferred) = InData%y(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%z) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1950,8 +2038,10 @@ SUBROUTINE MAP_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%z)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%z))-1 ) = PACK(InData%z,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%z) + DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) + DbKiBuf(Db_Xferred) = InData%z(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%xa) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1963,8 +2053,10 @@ SUBROUTINE MAP_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xa,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%xa)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%xa))-1 ) = PACK(InData%xa,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%xa) + DO i1 = LBOUND(InData%xa,1), UBOUND(InData%xa,1) + DbKiBuf(Db_Xferred) = InData%xa(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%ya) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1976,8 +2068,10 @@ SUBROUTINE MAP_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ya,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ya)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%ya))-1 ) = PACK(InData%ya,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%ya) + DO i1 = LBOUND(InData%ya,1), UBOUND(InData%ya,1) + DbKiBuf(Db_Xferred) = InData%ya(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%za) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1989,8 +2083,10 @@ SUBROUTINE MAP_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%za,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%za)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%za))-1 ) = PACK(InData%za,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%za) + DO i1 = LBOUND(InData%za,1), UBOUND(InData%za,1) + DbKiBuf(Db_Xferred) = InData%za(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%Fx_connect) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2002,8 +2098,10 @@ SUBROUTINE MAP_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fx_connect,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Fx_connect)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Fx_connect))-1 ) = PACK(InData%Fx_connect,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Fx_connect) + DO i1 = LBOUND(InData%Fx_connect,1), UBOUND(InData%Fx_connect,1) + DbKiBuf(Db_Xferred) = InData%Fx_connect(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%Fy_connect) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2015,8 +2113,10 @@ SUBROUTINE MAP_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fy_connect,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Fy_connect)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Fy_connect))-1 ) = PACK(InData%Fy_connect,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Fy_connect) + DO i1 = LBOUND(InData%Fy_connect,1), UBOUND(InData%Fy_connect,1) + DbKiBuf(Db_Xferred) = InData%Fy_connect(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%Fz_connect) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2028,8 +2128,10 @@ SUBROUTINE MAP_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fz_connect,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Fz_connect)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Fz_connect))-1 ) = PACK(InData%Fz_connect,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Fz_connect) + DO i1 = LBOUND(InData%Fz_connect,1), UBOUND(InData%Fz_connect,1) + DbKiBuf(Db_Xferred) = InData%Fz_connect(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%Fx_anchor) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2041,8 +2143,10 @@ SUBROUTINE MAP_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fx_anchor,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Fx_anchor)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Fx_anchor))-1 ) = PACK(InData%Fx_anchor,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Fx_anchor) + DO i1 = LBOUND(InData%Fx_anchor,1), UBOUND(InData%Fx_anchor,1) + DbKiBuf(Db_Xferred) = InData%Fx_anchor(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%Fy_anchor) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2054,8 +2158,10 @@ SUBROUTINE MAP_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fy_anchor,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Fy_anchor)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Fy_anchor))-1 ) = PACK(InData%Fy_anchor,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Fy_anchor) + DO i1 = LBOUND(InData%Fy_anchor,1), UBOUND(InData%Fy_anchor,1) + DbKiBuf(Db_Xferred) = InData%Fy_anchor(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%Fz_anchor) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2067,8 +2173,10 @@ SUBROUTINE MAP_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fz_anchor,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Fz_anchor)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Fz_anchor))-1 ) = PACK(InData%Fz_anchor,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Fz_anchor) + DO i1 = LBOUND(InData%Fz_anchor,1), UBOUND(InData%Fz_anchor,1) + DbKiBuf(Db_Xferred) = InData%Fz_anchor(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF END SUBROUTINE MAP_PackOtherState @@ -2085,12 +2193,6 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -2121,15 +2223,10 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E OutData%c_obj%H_Len = SIZE(OutData%H) IF (OutData%c_obj%H_Len > 0) & OutData%c_obj%H = C_LOC( OutData%H(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%H)>0) OutData%H = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%H))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%H) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%H,1), UBOUND(OutData%H,1) + OutData%H(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! V not allocated Int_Xferred = Int_Xferred + 1 @@ -2147,15 +2244,10 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E OutData%c_obj%V_Len = SIZE(OutData%V) IF (OutData%c_obj%V_Len > 0) & OutData%c_obj%V = C_LOC( OutData%V(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%V)>0) OutData%V = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%V))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%V) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%V,1), UBOUND(OutData%V,1) + OutData%V(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Ha not allocated Int_Xferred = Int_Xferred + 1 @@ -2173,15 +2265,10 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E OutData%c_obj%Ha_Len = SIZE(OutData%Ha) IF (OutData%c_obj%Ha_Len > 0) & OutData%c_obj%Ha = C_LOC( OutData%Ha(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Ha)>0) OutData%Ha = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Ha))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%Ha) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Ha,1), UBOUND(OutData%Ha,1) + OutData%Ha(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Va not allocated Int_Xferred = Int_Xferred + 1 @@ -2199,15 +2286,10 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E OutData%c_obj%Va_Len = SIZE(OutData%Va) IF (OutData%c_obj%Va_Len > 0) & OutData%c_obj%Va = C_LOC( OutData%Va(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Va)>0) OutData%Va = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Va))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%Va) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Va,1), UBOUND(OutData%Va,1) + OutData%Va(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x not allocated Int_Xferred = Int_Xferred + 1 @@ -2225,15 +2307,10 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E OutData%c_obj%x_Len = SIZE(OutData%x) IF (OutData%c_obj%x_Len > 0) & OutData%c_obj%x = C_LOC( OutData%x(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%x)>0) OutData%x = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%x))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%x) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) + OutData%x(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! y not allocated Int_Xferred = Int_Xferred + 1 @@ -2251,15 +2328,10 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E OutData%c_obj%y_Len = SIZE(OutData%y) IF (OutData%c_obj%y_Len > 0) & OutData%c_obj%y = C_LOC( OutData%y(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%y)>0) OutData%y = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%y))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%y) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%y,1), UBOUND(OutData%y,1) + OutData%y(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z not allocated Int_Xferred = Int_Xferred + 1 @@ -2277,15 +2349,10 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E OutData%c_obj%z_Len = SIZE(OutData%z) IF (OutData%c_obj%z_Len > 0) & OutData%c_obj%z = C_LOC( OutData%z(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%z)>0) OutData%z = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%z))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%z) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) + OutData%z(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xa not allocated Int_Xferred = Int_Xferred + 1 @@ -2303,15 +2370,10 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E OutData%c_obj%xa_Len = SIZE(OutData%xa) IF (OutData%c_obj%xa_Len > 0) & OutData%c_obj%xa = C_LOC( OutData%xa(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%xa)>0) OutData%xa = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%xa))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%xa) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%xa,1), UBOUND(OutData%xa,1) + OutData%xa(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ya not allocated Int_Xferred = Int_Xferred + 1 @@ -2329,15 +2391,10 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E OutData%c_obj%ya_Len = SIZE(OutData%ya) IF (OutData%c_obj%ya_Len > 0) & OutData%c_obj%ya = C_LOC( OutData%ya(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%ya)>0) OutData%ya = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%ya))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%ya) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%ya,1), UBOUND(OutData%ya,1) + OutData%ya(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! za not allocated Int_Xferred = Int_Xferred + 1 @@ -2355,15 +2412,10 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E OutData%c_obj%za_Len = SIZE(OutData%za) IF (OutData%c_obj%za_Len > 0) & OutData%c_obj%za = C_LOC( OutData%za(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%za)>0) OutData%za = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%za))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%za) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%za,1), UBOUND(OutData%za,1) + OutData%za(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fx_connect not allocated Int_Xferred = Int_Xferred + 1 @@ -2381,15 +2433,10 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E OutData%c_obj%Fx_connect_Len = SIZE(OutData%Fx_connect) IF (OutData%c_obj%Fx_connect_Len > 0) & OutData%c_obj%Fx_connect = C_LOC( OutData%Fx_connect(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Fx_connect)>0) OutData%Fx_connect = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Fx_connect))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%Fx_connect) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Fx_connect,1), UBOUND(OutData%Fx_connect,1) + OutData%Fx_connect(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fy_connect not allocated Int_Xferred = Int_Xferred + 1 @@ -2407,15 +2454,10 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E OutData%c_obj%Fy_connect_Len = SIZE(OutData%Fy_connect) IF (OutData%c_obj%Fy_connect_Len > 0) & OutData%c_obj%Fy_connect = C_LOC( OutData%Fy_connect(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Fy_connect)>0) OutData%Fy_connect = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Fy_connect))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%Fy_connect) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Fy_connect,1), UBOUND(OutData%Fy_connect,1) + OutData%Fy_connect(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fz_connect not allocated Int_Xferred = Int_Xferred + 1 @@ -2433,15 +2475,10 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E OutData%c_obj%Fz_connect_Len = SIZE(OutData%Fz_connect) IF (OutData%c_obj%Fz_connect_Len > 0) & OutData%c_obj%Fz_connect = C_LOC( OutData%Fz_connect(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Fz_connect)>0) OutData%Fz_connect = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Fz_connect))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%Fz_connect) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Fz_connect,1), UBOUND(OutData%Fz_connect,1) + OutData%Fz_connect(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fx_anchor not allocated Int_Xferred = Int_Xferred + 1 @@ -2459,15 +2496,10 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E OutData%c_obj%Fx_anchor_Len = SIZE(OutData%Fx_anchor) IF (OutData%c_obj%Fx_anchor_Len > 0) & OutData%c_obj%Fx_anchor = C_LOC( OutData%Fx_anchor(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Fx_anchor)>0) OutData%Fx_anchor = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Fx_anchor))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%Fx_anchor) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Fx_anchor,1), UBOUND(OutData%Fx_anchor,1) + OutData%Fx_anchor(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fy_anchor not allocated Int_Xferred = Int_Xferred + 1 @@ -2485,15 +2517,10 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E OutData%c_obj%Fy_anchor_Len = SIZE(OutData%Fy_anchor) IF (OutData%c_obj%Fy_anchor_Len > 0) & OutData%c_obj%Fy_anchor = C_LOC( OutData%Fy_anchor(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Fy_anchor)>0) OutData%Fy_anchor = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Fy_anchor))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%Fy_anchor) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Fy_anchor,1), UBOUND(OutData%Fy_anchor,1) + OutData%Fy_anchor(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fz_anchor not allocated Int_Xferred = Int_Xferred + 1 @@ -2511,139 +2538,383 @@ SUBROUTINE MAP_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E OutData%c_obj%Fz_anchor_Len = SIZE(OutData%Fz_anchor) IF (OutData%c_obj%Fz_anchor_Len > 0) & OutData%c_obj%Fz_anchor = C_LOC( OutData%Fz_anchor(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Fz_anchor)>0) OutData%Fz_anchor = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Fz_anchor))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%Fz_anchor) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Fz_anchor,1), UBOUND(OutData%Fz_anchor,1) + OutData%Fz_anchor(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF END SUBROUTINE MAP_UnPackOtherState - SUBROUTINE MAP_C2Fary_CopyOtherState( OtherStateData, ErrStat, ErrMsg ) + SUBROUTINE MAP_C2Fary_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ) TYPE(MAP_OtherStateType), INTENT(INOUT) :: OtherStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" - ! -- H OtherState Data fields - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%H ) ) THEN - NULLIFY( OtherStateData%H ) + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers ELSE - CALL C_F_POINTER(OtherStateData%C_obj%H, OtherStateData%H, (/OtherStateData%C_obj%H_Len/)) + SkipPointers_local = .false. + END IF + + ! -- H OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%H ) ) THEN + NULLIFY( OtherStateData%H ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%H, OtherStateData%H, (/OtherStateData%C_obj%H_Len/)) + END IF END IF ! -- V OtherState Data fields - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%V ) ) THEN - NULLIFY( OtherStateData%V ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%V, OtherStateData%V, (/OtherStateData%C_obj%V_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%V ) ) THEN + NULLIFY( OtherStateData%V ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%V, OtherStateData%V, (/OtherStateData%C_obj%V_Len/)) + END IF END IF ! -- Ha OtherState Data fields - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Ha ) ) THEN - NULLIFY( OtherStateData%Ha ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%Ha, OtherStateData%Ha, (/OtherStateData%C_obj%Ha_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Ha ) ) THEN + NULLIFY( OtherStateData%Ha ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%Ha, OtherStateData%Ha, (/OtherStateData%C_obj%Ha_Len/)) + END IF END IF ! -- Va OtherState Data fields - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Va ) ) THEN - NULLIFY( OtherStateData%Va ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%Va, OtherStateData%Va, (/OtherStateData%C_obj%Va_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Va ) ) THEN + NULLIFY( OtherStateData%Va ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%Va, OtherStateData%Va, (/OtherStateData%C_obj%Va_Len/)) + END IF END IF ! -- x OtherState Data fields - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%x ) ) THEN - NULLIFY( OtherStateData%x ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%x, OtherStateData%x, (/OtherStateData%C_obj%x_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%x ) ) THEN + NULLIFY( OtherStateData%x ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%x, OtherStateData%x, (/OtherStateData%C_obj%x_Len/)) + END IF END IF ! -- y OtherState Data fields - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%y ) ) THEN - NULLIFY( OtherStateData%y ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%y, OtherStateData%y, (/OtherStateData%C_obj%y_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%y ) ) THEN + NULLIFY( OtherStateData%y ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%y, OtherStateData%y, (/OtherStateData%C_obj%y_Len/)) + END IF END IF ! -- z OtherState Data fields - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%z ) ) THEN - NULLIFY( OtherStateData%z ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%z, OtherStateData%z, (/OtherStateData%C_obj%z_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%z ) ) THEN + NULLIFY( OtherStateData%z ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%z, OtherStateData%z, (/OtherStateData%C_obj%z_Len/)) + END IF END IF ! -- xa OtherState Data fields - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%xa ) ) THEN - NULLIFY( OtherStateData%xa ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%xa, OtherStateData%xa, (/OtherStateData%C_obj%xa_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%xa ) ) THEN + NULLIFY( OtherStateData%xa ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%xa, OtherStateData%xa, (/OtherStateData%C_obj%xa_Len/)) + END IF END IF ! -- ya OtherState Data fields - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%ya ) ) THEN - NULLIFY( OtherStateData%ya ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%ya, OtherStateData%ya, (/OtherStateData%C_obj%ya_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%ya ) ) THEN + NULLIFY( OtherStateData%ya ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%ya, OtherStateData%ya, (/OtherStateData%C_obj%ya_Len/)) + END IF END IF ! -- za OtherState Data fields - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%za ) ) THEN - NULLIFY( OtherStateData%za ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%za, OtherStateData%za, (/OtherStateData%C_obj%za_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%za ) ) THEN + NULLIFY( OtherStateData%za ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%za, OtherStateData%za, (/OtherStateData%C_obj%za_Len/)) + END IF END IF ! -- Fx_connect OtherState Data fields - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fx_connect ) ) THEN - NULLIFY( OtherStateData%Fx_connect ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%Fx_connect, OtherStateData%Fx_connect, (/OtherStateData%C_obj%Fx_connect_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fx_connect ) ) THEN + NULLIFY( OtherStateData%Fx_connect ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%Fx_connect, OtherStateData%Fx_connect, (/OtherStateData%C_obj%Fx_connect_Len/)) + END IF END IF ! -- Fy_connect OtherState Data fields - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fy_connect ) ) THEN - NULLIFY( OtherStateData%Fy_connect ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%Fy_connect, OtherStateData%Fy_connect, (/OtherStateData%C_obj%Fy_connect_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fy_connect ) ) THEN + NULLIFY( OtherStateData%Fy_connect ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%Fy_connect, OtherStateData%Fy_connect, (/OtherStateData%C_obj%Fy_connect_Len/)) + END IF END IF ! -- Fz_connect OtherState Data fields - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fz_connect ) ) THEN - NULLIFY( OtherStateData%Fz_connect ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%Fz_connect, OtherStateData%Fz_connect, (/OtherStateData%C_obj%Fz_connect_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fz_connect ) ) THEN + NULLIFY( OtherStateData%Fz_connect ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%Fz_connect, OtherStateData%Fz_connect, (/OtherStateData%C_obj%Fz_connect_Len/)) + END IF END IF ! -- Fx_anchor OtherState Data fields - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fx_anchor ) ) THEN - NULLIFY( OtherStateData%Fx_anchor ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%Fx_anchor, OtherStateData%Fx_anchor, (/OtherStateData%C_obj%Fx_anchor_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fx_anchor ) ) THEN + NULLIFY( OtherStateData%Fx_anchor ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%Fx_anchor, OtherStateData%Fx_anchor, (/OtherStateData%C_obj%Fx_anchor_Len/)) + END IF END IF ! -- Fy_anchor OtherState Data fields - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fy_anchor ) ) THEN - NULLIFY( OtherStateData%Fy_anchor ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%Fy_anchor, OtherStateData%Fy_anchor, (/OtherStateData%C_obj%Fy_anchor_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fy_anchor ) ) THEN + NULLIFY( OtherStateData%Fy_anchor ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%Fy_anchor, OtherStateData%Fy_anchor, (/OtherStateData%C_obj%Fy_anchor_Len/)) + END IF END IF ! -- Fz_anchor OtherState Data fields - IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fz_anchor ) ) THEN - NULLIFY( OtherStateData%Fz_anchor ) - ELSE - CALL C_F_POINTER(OtherStateData%C_obj%Fz_anchor, OtherStateData%Fz_anchor, (/OtherStateData%C_obj%Fz_anchor_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OtherStateData%C_obj%Fz_anchor ) ) THEN + NULLIFY( OtherStateData%Fz_anchor ) + ELSE + CALL C_F_POINTER(OtherStateData%C_obj%Fz_anchor, OtherStateData%Fz_anchor, (/OtherStateData%C_obj%Fz_anchor_Len/)) + END IF END IF END SUBROUTINE MAP_C2Fary_CopyOtherState + SUBROUTINE MAP_F2C_CopyOtherState( OtherStateData, ErrStat, ErrMsg, SkipPointers ) + TYPE(MAP_OtherStateType), INTENT(INOUT) :: OtherStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + + ! -- H OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OtherStateData%H)) THEN + OtherStateData%c_obj%H_Len = 0 + OtherStateData%c_obj%H = C_NULL_PTR + ELSE + OtherStateData%c_obj%H_Len = SIZE(OtherStateData%H) + IF (OtherStateData%c_obj%H_Len > 0) & + OtherStateData%c_obj%H = C_LOC( OtherStateData%H( LBOUND(OtherStateData%H,1) ) ) + END IF + END IF + + ! -- V OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OtherStateData%V)) THEN + OtherStateData%c_obj%V_Len = 0 + OtherStateData%c_obj%V = C_NULL_PTR + ELSE + OtherStateData%c_obj%V_Len = SIZE(OtherStateData%V) + IF (OtherStateData%c_obj%V_Len > 0) & + OtherStateData%c_obj%V = C_LOC( OtherStateData%V( LBOUND(OtherStateData%V,1) ) ) + END IF + END IF + + ! -- Ha OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OtherStateData%Ha)) THEN + OtherStateData%c_obj%Ha_Len = 0 + OtherStateData%c_obj%Ha = C_NULL_PTR + ELSE + OtherStateData%c_obj%Ha_Len = SIZE(OtherStateData%Ha) + IF (OtherStateData%c_obj%Ha_Len > 0) & + OtherStateData%c_obj%Ha = C_LOC( OtherStateData%Ha( LBOUND(OtherStateData%Ha,1) ) ) + END IF + END IF + + ! -- Va OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OtherStateData%Va)) THEN + OtherStateData%c_obj%Va_Len = 0 + OtherStateData%c_obj%Va = C_NULL_PTR + ELSE + OtherStateData%c_obj%Va_Len = SIZE(OtherStateData%Va) + IF (OtherStateData%c_obj%Va_Len > 0) & + OtherStateData%c_obj%Va = C_LOC( OtherStateData%Va( LBOUND(OtherStateData%Va,1) ) ) + END IF + END IF + + ! -- x OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OtherStateData%x)) THEN + OtherStateData%c_obj%x_Len = 0 + OtherStateData%c_obj%x = C_NULL_PTR + ELSE + OtherStateData%c_obj%x_Len = SIZE(OtherStateData%x) + IF (OtherStateData%c_obj%x_Len > 0) & + OtherStateData%c_obj%x = C_LOC( OtherStateData%x( LBOUND(OtherStateData%x,1) ) ) + END IF + END IF + + ! -- y OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OtherStateData%y)) THEN + OtherStateData%c_obj%y_Len = 0 + OtherStateData%c_obj%y = C_NULL_PTR + ELSE + OtherStateData%c_obj%y_Len = SIZE(OtherStateData%y) + IF (OtherStateData%c_obj%y_Len > 0) & + OtherStateData%c_obj%y = C_LOC( OtherStateData%y( LBOUND(OtherStateData%y,1) ) ) + END IF + END IF + + ! -- z OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OtherStateData%z)) THEN + OtherStateData%c_obj%z_Len = 0 + OtherStateData%c_obj%z = C_NULL_PTR + ELSE + OtherStateData%c_obj%z_Len = SIZE(OtherStateData%z) + IF (OtherStateData%c_obj%z_Len > 0) & + OtherStateData%c_obj%z = C_LOC( OtherStateData%z( LBOUND(OtherStateData%z,1) ) ) + END IF + END IF + + ! -- xa OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OtherStateData%xa)) THEN + OtherStateData%c_obj%xa_Len = 0 + OtherStateData%c_obj%xa = C_NULL_PTR + ELSE + OtherStateData%c_obj%xa_Len = SIZE(OtherStateData%xa) + IF (OtherStateData%c_obj%xa_Len > 0) & + OtherStateData%c_obj%xa = C_LOC( OtherStateData%xa( LBOUND(OtherStateData%xa,1) ) ) + END IF + END IF + + ! -- ya OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OtherStateData%ya)) THEN + OtherStateData%c_obj%ya_Len = 0 + OtherStateData%c_obj%ya = C_NULL_PTR + ELSE + OtherStateData%c_obj%ya_Len = SIZE(OtherStateData%ya) + IF (OtherStateData%c_obj%ya_Len > 0) & + OtherStateData%c_obj%ya = C_LOC( OtherStateData%ya( LBOUND(OtherStateData%ya,1) ) ) + END IF + END IF + + ! -- za OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OtherStateData%za)) THEN + OtherStateData%c_obj%za_Len = 0 + OtherStateData%c_obj%za = C_NULL_PTR + ELSE + OtherStateData%c_obj%za_Len = SIZE(OtherStateData%za) + IF (OtherStateData%c_obj%za_Len > 0) & + OtherStateData%c_obj%za = C_LOC( OtherStateData%za( LBOUND(OtherStateData%za,1) ) ) + END IF + END IF + + ! -- Fx_connect OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OtherStateData%Fx_connect)) THEN + OtherStateData%c_obj%Fx_connect_Len = 0 + OtherStateData%c_obj%Fx_connect = C_NULL_PTR + ELSE + OtherStateData%c_obj%Fx_connect_Len = SIZE(OtherStateData%Fx_connect) + IF (OtherStateData%c_obj%Fx_connect_Len > 0) & + OtherStateData%c_obj%Fx_connect = C_LOC( OtherStateData%Fx_connect( LBOUND(OtherStateData%Fx_connect,1) ) ) + END IF + END IF + + ! -- Fy_connect OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OtherStateData%Fy_connect)) THEN + OtherStateData%c_obj%Fy_connect_Len = 0 + OtherStateData%c_obj%Fy_connect = C_NULL_PTR + ELSE + OtherStateData%c_obj%Fy_connect_Len = SIZE(OtherStateData%Fy_connect) + IF (OtherStateData%c_obj%Fy_connect_Len > 0) & + OtherStateData%c_obj%Fy_connect = C_LOC( OtherStateData%Fy_connect( LBOUND(OtherStateData%Fy_connect,1) ) ) + END IF + END IF + + ! -- Fz_connect OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OtherStateData%Fz_connect)) THEN + OtherStateData%c_obj%Fz_connect_Len = 0 + OtherStateData%c_obj%Fz_connect = C_NULL_PTR + ELSE + OtherStateData%c_obj%Fz_connect_Len = SIZE(OtherStateData%Fz_connect) + IF (OtherStateData%c_obj%Fz_connect_Len > 0) & + OtherStateData%c_obj%Fz_connect = C_LOC( OtherStateData%Fz_connect( LBOUND(OtherStateData%Fz_connect,1) ) ) + END IF + END IF + + ! -- Fx_anchor OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OtherStateData%Fx_anchor)) THEN + OtherStateData%c_obj%Fx_anchor_Len = 0 + OtherStateData%c_obj%Fx_anchor = C_NULL_PTR + ELSE + OtherStateData%c_obj%Fx_anchor_Len = SIZE(OtherStateData%Fx_anchor) + IF (OtherStateData%c_obj%Fx_anchor_Len > 0) & + OtherStateData%c_obj%Fx_anchor = C_LOC( OtherStateData%Fx_anchor( LBOUND(OtherStateData%Fx_anchor,1) ) ) + END IF + END IF + + ! -- Fy_anchor OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OtherStateData%Fy_anchor)) THEN + OtherStateData%c_obj%Fy_anchor_Len = 0 + OtherStateData%c_obj%Fy_anchor = C_NULL_PTR + ELSE + OtherStateData%c_obj%Fy_anchor_Len = SIZE(OtherStateData%Fy_anchor) + IF (OtherStateData%c_obj%Fy_anchor_Len > 0) & + OtherStateData%c_obj%Fy_anchor = C_LOC( OtherStateData%Fy_anchor( LBOUND(OtherStateData%Fy_anchor,1) ) ) + END IF + END IF + + ! -- Fz_anchor OtherState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OtherStateData%Fz_anchor)) THEN + OtherStateData%c_obj%Fz_anchor_Len = 0 + OtherStateData%c_obj%Fz_anchor = C_NULL_PTR + ELSE + OtherStateData%c_obj%Fz_anchor_Len = SIZE(OtherStateData%Fz_anchor) + IF (OtherStateData%c_obj%Fz_anchor_Len > 0) & + OtherStateData%c_obj%Fz_anchor = C_LOC( OtherStateData%Fz_anchor( LBOUND(OtherStateData%Fz_anchor,1) ) ) + END IF + END IF + END SUBROUTINE MAP_F2C_CopyOtherState + SUBROUTINE MAP_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) TYPE(MAP_ConstraintStateType), INTENT(IN) :: SrcConstrStateData TYPE(MAP_ConstraintStateType), INTENT(INOUT) :: DstConstrStateData @@ -2876,8 +3147,10 @@ SUBROUTINE MAP_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%H,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%H)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%H))-1 ) = PACK(InData%H,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%H) + DO i1 = LBOUND(InData%H,1), UBOUND(InData%H,1) + DbKiBuf(Db_Xferred) = InData%H(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%V) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2889,8 +3162,10 @@ SUBROUTINE MAP_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%V,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%V)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%V))-1 ) = PACK(InData%V,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%V) + DO i1 = LBOUND(InData%V,1), UBOUND(InData%V,1) + DbKiBuf(Db_Xferred) = InData%V(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%x) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2902,8 +3177,10 @@ SUBROUTINE MAP_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%x)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%x))-1 ) = PACK(InData%x,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%x) + DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) + DbKiBuf(Db_Xferred) = InData%x(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%y) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2915,8 +3192,10 @@ SUBROUTINE MAP_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%y)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%y))-1 ) = PACK(InData%y,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%y) + DO i1 = LBOUND(InData%y,1), UBOUND(InData%y,1) + DbKiBuf(Db_Xferred) = InData%y(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%z) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2928,8 +3207,10 @@ SUBROUTINE MAP_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%z)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%z))-1 ) = PACK(InData%z,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%z) + DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) + DbKiBuf(Db_Xferred) = InData%z(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF END SUBROUTINE MAP_PackConstrState @@ -2946,12 +3227,6 @@ SUBROUTINE MAP_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -2982,15 +3257,10 @@ SUBROUTINE MAP_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, OutData%c_obj%H_Len = SIZE(OutData%H) IF (OutData%c_obj%H_Len > 0) & OutData%c_obj%H = C_LOC( OutData%H(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%H)>0) OutData%H = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%H))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%H) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%H,1), UBOUND(OutData%H,1) + OutData%H(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! V not allocated Int_Xferred = Int_Xferred + 1 @@ -3008,15 +3278,10 @@ SUBROUTINE MAP_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, OutData%c_obj%V_Len = SIZE(OutData%V) IF (OutData%c_obj%V_Len > 0) & OutData%c_obj%V = C_LOC( OutData%V(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%V)>0) OutData%V = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%V))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%V) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%V,1), UBOUND(OutData%V,1) + OutData%V(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x not allocated Int_Xferred = Int_Xferred + 1 @@ -3034,15 +3299,10 @@ SUBROUTINE MAP_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, OutData%c_obj%x_Len = SIZE(OutData%x) IF (OutData%c_obj%x_Len > 0) & OutData%c_obj%x = C_LOC( OutData%x(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%x)>0) OutData%x = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%x))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%x) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) + OutData%x(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! y not allocated Int_Xferred = Int_Xferred + 1 @@ -3060,15 +3320,10 @@ SUBROUTINE MAP_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, OutData%c_obj%y_Len = SIZE(OutData%y) IF (OutData%c_obj%y_Len > 0) & OutData%c_obj%y = C_LOC( OutData%y(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%y)>0) OutData%y = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%y))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%y) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%y,1), UBOUND(OutData%y,1) + OutData%y(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z not allocated Int_Xferred = Int_Xferred + 1 @@ -3086,62 +3341,152 @@ SUBROUTINE MAP_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, OutData%c_obj%z_Len = SIZE(OutData%z) IF (OutData%c_obj%z_Len > 0) & OutData%c_obj%z = C_LOC( OutData%z(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%z)>0) OutData%z = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%z))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%z) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) + OutData%z(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF END SUBROUTINE MAP_UnPackConstrState - SUBROUTINE MAP_C2Fary_CopyConstrState( ConstrStateData, ErrStat, ErrMsg ) + SUBROUTINE MAP_C2Fary_CopyConstrState( ConstrStateData, ErrStat, ErrMsg, SkipPointers ) TYPE(MAP_ConstraintStateType), INTENT(INOUT) :: ConstrStateData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" - ! -- H ConstrState Data fields - IF ( .NOT. C_ASSOCIATED( ConstrStateData%C_obj%H ) ) THEN - NULLIFY( ConstrStateData%H ) + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers ELSE - CALL C_F_POINTER(ConstrStateData%C_obj%H, ConstrStateData%H, (/ConstrStateData%C_obj%H_Len/)) + SkipPointers_local = .false. + END IF + + ! -- H ConstrState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ConstrStateData%C_obj%H ) ) THEN + NULLIFY( ConstrStateData%H ) + ELSE + CALL C_F_POINTER(ConstrStateData%C_obj%H, ConstrStateData%H, (/ConstrStateData%C_obj%H_Len/)) + END IF END IF ! -- V ConstrState Data fields - IF ( .NOT. C_ASSOCIATED( ConstrStateData%C_obj%V ) ) THEN - NULLIFY( ConstrStateData%V ) - ELSE - CALL C_F_POINTER(ConstrStateData%C_obj%V, ConstrStateData%V, (/ConstrStateData%C_obj%V_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ConstrStateData%C_obj%V ) ) THEN + NULLIFY( ConstrStateData%V ) + ELSE + CALL C_F_POINTER(ConstrStateData%C_obj%V, ConstrStateData%V, (/ConstrStateData%C_obj%V_Len/)) + END IF END IF ! -- x ConstrState Data fields - IF ( .NOT. C_ASSOCIATED( ConstrStateData%C_obj%x ) ) THEN - NULLIFY( ConstrStateData%x ) - ELSE - CALL C_F_POINTER(ConstrStateData%C_obj%x, ConstrStateData%x, (/ConstrStateData%C_obj%x_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ConstrStateData%C_obj%x ) ) THEN + NULLIFY( ConstrStateData%x ) + ELSE + CALL C_F_POINTER(ConstrStateData%C_obj%x, ConstrStateData%x, (/ConstrStateData%C_obj%x_Len/)) + END IF END IF ! -- y ConstrState Data fields - IF ( .NOT. C_ASSOCIATED( ConstrStateData%C_obj%y ) ) THEN - NULLIFY( ConstrStateData%y ) - ELSE - CALL C_F_POINTER(ConstrStateData%C_obj%y, ConstrStateData%y, (/ConstrStateData%C_obj%y_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ConstrStateData%C_obj%y ) ) THEN + NULLIFY( ConstrStateData%y ) + ELSE + CALL C_F_POINTER(ConstrStateData%C_obj%y, ConstrStateData%y, (/ConstrStateData%C_obj%y_Len/)) + END IF END IF ! -- z ConstrState Data fields - IF ( .NOT. C_ASSOCIATED( ConstrStateData%C_obj%z ) ) THEN - NULLIFY( ConstrStateData%z ) - ELSE - CALL C_F_POINTER(ConstrStateData%C_obj%z, ConstrStateData%z, (/ConstrStateData%C_obj%z_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ConstrStateData%C_obj%z ) ) THEN + NULLIFY( ConstrStateData%z ) + ELSE + CALL C_F_POINTER(ConstrStateData%C_obj%z, ConstrStateData%z, (/ConstrStateData%C_obj%z_Len/)) + END IF END IF END SUBROUTINE MAP_C2Fary_CopyConstrState + SUBROUTINE MAP_F2C_CopyConstrState( ConstrStateData, ErrStat, ErrMsg, SkipPointers ) + TYPE(MAP_ConstraintStateType), INTENT(INOUT) :: ConstrStateData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + + ! -- H ConstrState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(ConstrStateData%H)) THEN + ConstrStateData%c_obj%H_Len = 0 + ConstrStateData%c_obj%H = C_NULL_PTR + ELSE + ConstrStateData%c_obj%H_Len = SIZE(ConstrStateData%H) + IF (ConstrStateData%c_obj%H_Len > 0) & + ConstrStateData%c_obj%H = C_LOC( ConstrStateData%H( LBOUND(ConstrStateData%H,1) ) ) + END IF + END IF + + ! -- V ConstrState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(ConstrStateData%V)) THEN + ConstrStateData%c_obj%V_Len = 0 + ConstrStateData%c_obj%V = C_NULL_PTR + ELSE + ConstrStateData%c_obj%V_Len = SIZE(ConstrStateData%V) + IF (ConstrStateData%c_obj%V_Len > 0) & + ConstrStateData%c_obj%V = C_LOC( ConstrStateData%V( LBOUND(ConstrStateData%V,1) ) ) + END IF + END IF + + ! -- x ConstrState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(ConstrStateData%x)) THEN + ConstrStateData%c_obj%x_Len = 0 + ConstrStateData%c_obj%x = C_NULL_PTR + ELSE + ConstrStateData%c_obj%x_Len = SIZE(ConstrStateData%x) + IF (ConstrStateData%c_obj%x_Len > 0) & + ConstrStateData%c_obj%x = C_LOC( ConstrStateData%x( LBOUND(ConstrStateData%x,1) ) ) + END IF + END IF + + ! -- y ConstrState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(ConstrStateData%y)) THEN + ConstrStateData%c_obj%y_Len = 0 + ConstrStateData%c_obj%y = C_NULL_PTR + ELSE + ConstrStateData%c_obj%y_Len = SIZE(ConstrStateData%y) + IF (ConstrStateData%c_obj%y_Len > 0) & + ConstrStateData%c_obj%y = C_LOC( ConstrStateData%y( LBOUND(ConstrStateData%y,1) ) ) + END IF + END IF + + ! -- z ConstrState Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(ConstrStateData%z)) THEN + ConstrStateData%c_obj%z_Len = 0 + ConstrStateData%c_obj%z = C_NULL_PTR + ELSE + ConstrStateData%c_obj%z_Len = SIZE(ConstrStateData%z) + IF (ConstrStateData%c_obj%z_Len > 0) & + ConstrStateData%c_obj%z = C_LOC( ConstrStateData%z( LBOUND(ConstrStateData%z,1) ) ) + END IF + END IF + END SUBROUTINE MAP_F2C_CopyConstrState + SUBROUTINE MAP_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) TYPE(MAP_ParameterType), INTENT(IN) :: SrcParamData TYPE(MAP_ParameterType), INTENT(INOUT) :: DstParamData @@ -3275,28 +3620,28 @@ SUBROUTINE MAP_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%g - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%depth - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%rho_sea - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%dt - Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%g + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%depth + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%rho_sea + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%dt + Db_Xferred = Db_Xferred + 1 DO i1 = LBOUND(InData%InputLines,1), UBOUND(InData%InputLines,1) - DO I = 1, LEN(InData%InputLines) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputLines(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 + DO I = 1, LEN(InData%InputLines) + IntKiBuf(Int_Xferred) = ICHAR(InData%InputLines(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO DO i1 = LBOUND(InData%InputLineType,1), UBOUND(InData%InputLineType,1) - DO I = 1, LEN(InData%InputLineType) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputLineType(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%numOuts - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%InputLineType) + IntKiBuf(Int_Xferred) = ICHAR(InData%InputLineType(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + IntKiBuf(Int_Xferred) = InData%numOuts + Int_Xferred = Int_Xferred + 1 CALL MAP_Fortran_Packlin_paramtype( Re_Buf, Db_Buf, Int_Buf, InData%LinParams, ErrStat2, ErrMsg2, OnlySize ) ! LinParams CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3340,12 +3685,6 @@ SUBROUTINE MAP_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -3360,50 +3699,36 @@ SUBROUTINE MAP_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%g = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%g = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 OutData%C_obj%g = OutData%g - OutData%depth = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%depth = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 OutData%C_obj%depth = OutData%depth - OutData%rho_sea = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%rho_sea = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 OutData%C_obj%rho_sea = OutData%rho_sea - OutData%dt = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%dt = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 OutData%C_obj%dt = OutData%dt i1_l = LBOUND(OutData%InputLines,1) i1_u = UBOUND(OutData%InputLines,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. DO i1 = LBOUND(OutData%InputLines,1), UBOUND(OutData%InputLines,1) - DO I = 1, LEN(OutData%InputLines) - OutData%InputLines(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - DEALLOCATE(mask1) + DO I = 1, LEN(OutData%InputLines) + OutData%InputLines(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO i1_l = LBOUND(OutData%InputLineType,1) i1_u = UBOUND(OutData%InputLineType,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. DO i1 = LBOUND(OutData%InputLineType,1), UBOUND(OutData%InputLineType,1) - DO I = 1, LEN(OutData%InputLineType) - OutData%InputLineType(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - DEALLOCATE(mask1) - OutData%numOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%InputLineType) + OutData%InputLineType(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + OutData%numOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 OutData%C_obj%numOuts = OutData%numOuts Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -3447,13 +3772,21 @@ SUBROUTINE MAP_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END SUBROUTINE MAP_UnPackParam - SUBROUTINE MAP_C2Fary_CopyParam( ParamData, ErrStat, ErrMsg ) + SUBROUTINE MAP_C2Fary_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) TYPE(MAP_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF ParamData%g = ParamData%C_obj%g ParamData%depth = ParamData%C_obj%depth ParamData%rho_sea = ParamData%C_obj%rho_sea @@ -3461,6 +3794,28 @@ SUBROUTINE MAP_C2Fary_CopyParam( ParamData, ErrStat, ErrMsg ) ParamData%numOuts = ParamData%C_obj%numOuts END SUBROUTINE MAP_C2Fary_CopyParam + SUBROUTINE MAP_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) + TYPE(MAP_ParameterType), INTENT(INOUT) :: ParamData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + ParamData%C_obj%g = ParamData%g + ParamData%C_obj%depth = ParamData%depth + ParamData%C_obj%rho_sea = ParamData%rho_sea + ParamData%C_obj%dt = ParamData%dt + ParamData%C_obj%numOuts = ParamData%numOuts + END SUBROUTINE MAP_F2C_CopyParam + SUBROUTINE MAP_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) TYPE(MAP_InputType), INTENT(INOUT) :: SrcInputData TYPE(MAP_InputType), INTENT(INOUT) :: DstInputData @@ -3663,8 +4018,10 @@ SUBROUTINE MAP_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%x)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%x))-1 ) = PACK(InData%x,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%x) + DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) + DbKiBuf(Db_Xferred) = InData%x(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%y) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3676,8 +4033,10 @@ SUBROUTINE MAP_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%y)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%y))-1 ) = PACK(InData%y,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%y) + DO i1 = LBOUND(InData%y,1), UBOUND(InData%y,1) + DbKiBuf(Db_Xferred) = InData%y(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%z) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3689,8 +4048,10 @@ SUBROUTINE MAP_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%z)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%z))-1 ) = PACK(InData%z,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%z) + DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) + DbKiBuf(Db_Xferred) = InData%z(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF CALL MeshPack( InData%PtFairDisplacement, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! PtFairDisplacement CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -3735,12 +4096,6 @@ SUBROUTINE MAP_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -3771,15 +4126,10 @@ SUBROUTINE MAP_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg OutData%c_obj%x_Len = SIZE(OutData%x) IF (OutData%c_obj%x_Len > 0) & OutData%c_obj%x = C_LOC( OutData%x(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%x)>0) OutData%x = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%x))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%x) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) + OutData%x(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! y not allocated Int_Xferred = Int_Xferred + 1 @@ -3797,15 +4147,10 @@ SUBROUTINE MAP_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg OutData%c_obj%y_Len = SIZE(OutData%y) IF (OutData%c_obj%y_Len > 0) & OutData%c_obj%y = C_LOC( OutData%y(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%y)>0) OutData%y = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%y))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%y) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%y,1), UBOUND(OutData%y,1) + OutData%y(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z not allocated Int_Xferred = Int_Xferred + 1 @@ -3823,15 +4168,10 @@ SUBROUTINE MAP_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg OutData%c_obj%z_Len = SIZE(OutData%z) IF (OutData%c_obj%z_Len > 0) & OutData%c_obj%z = C_LOC( OutData%z(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%z)>0) OutData%z = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%z))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%z) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) + OutData%z(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -3875,36 +4215,103 @@ SUBROUTINE MAP_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END SUBROUTINE MAP_UnPackInput - SUBROUTINE MAP_C2Fary_CopyInput( InputData, ErrStat, ErrMsg ) + SUBROUTINE MAP_C2Fary_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) TYPE(MAP_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" - ! -- x Input Data fields - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%x ) ) THEN - NULLIFY( InputData%x ) + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers ELSE - CALL C_F_POINTER(InputData%C_obj%x, InputData%x, (/InputData%C_obj%x_Len/)) + SkipPointers_local = .false. + END IF + + ! -- x Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%x ) ) THEN + NULLIFY( InputData%x ) + ELSE + CALL C_F_POINTER(InputData%C_obj%x, InputData%x, (/InputData%C_obj%x_Len/)) + END IF END IF ! -- y Input Data fields - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%y ) ) THEN - NULLIFY( InputData%y ) - ELSE - CALL C_F_POINTER(InputData%C_obj%y, InputData%y, (/InputData%C_obj%y_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%y ) ) THEN + NULLIFY( InputData%y ) + ELSE + CALL C_F_POINTER(InputData%C_obj%y, InputData%y, (/InputData%C_obj%y_Len/)) + END IF END IF ! -- z Input Data fields - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%z ) ) THEN - NULLIFY( InputData%z ) - ELSE - CALL C_F_POINTER(InputData%C_obj%z, InputData%z, (/InputData%C_obj%z_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%z ) ) THEN + NULLIFY( InputData%z ) + ELSE + CALL C_F_POINTER(InputData%C_obj%z, InputData%z, (/InputData%C_obj%z_Len/)) + END IF END IF END SUBROUTINE MAP_C2Fary_CopyInput + SUBROUTINE MAP_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(MAP_InputType), INTENT(INOUT) :: InputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + + ! -- x Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%x)) THEN + InputData%c_obj%x_Len = 0 + InputData%c_obj%x = C_NULL_PTR + ELSE + InputData%c_obj%x_Len = SIZE(InputData%x) + IF (InputData%c_obj%x_Len > 0) & + InputData%c_obj%x = C_LOC( InputData%x( LBOUND(InputData%x,1) ) ) + END IF + END IF + + ! -- y Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%y)) THEN + InputData%c_obj%y_Len = 0 + InputData%c_obj%y = C_NULL_PTR + ELSE + InputData%c_obj%y_Len = SIZE(InputData%y) + IF (InputData%c_obj%y_Len > 0) & + InputData%c_obj%y = C_LOC( InputData%y( LBOUND(InputData%y,1) ) ) + END IF + END IF + + ! -- z Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%z)) THEN + InputData%c_obj%z_Len = 0 + InputData%c_obj%z = C_NULL_PTR + ELSE + InputData%c_obj%z_Len = SIZE(InputData%z) + IF (InputData%c_obj%z_Len > 0) & + InputData%c_obj%z = C_LOC( InputData%z( LBOUND(InputData%z,1) ) ) + END IF + END IF + END SUBROUTINE MAP_F2C_CopyInput + SUBROUTINE MAP_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(MAP_OutputType), INTENT(INOUT) :: SrcOutputData TYPE(MAP_OutputType), INTENT(INOUT) :: DstOutputData @@ -3976,7 +4383,6 @@ SUBROUTINE MAP_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrM END IF END IF DstOutputData%WriteOutput = SrcOutputData%WriteOutput - DstOutputData%C_obj%WriteOutput = SrcOutputData%C_obj%WriteOutput ENDIF IF (ASSOCIATED(SrcOutputData%wrtOutput)) THEN i1_l = LBOUND(SrcOutputData%wrtOutput,1) @@ -4154,8 +4560,10 @@ SUBROUTINE MAP_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fx,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Fx)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Fx))-1 ) = PACK(InData%Fx,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Fx) + DO i1 = LBOUND(InData%Fx,1), UBOUND(InData%Fx,1) + DbKiBuf(Db_Xferred) = InData%Fx(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%Fy) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4167,8 +4575,10 @@ SUBROUTINE MAP_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fy,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Fy)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Fy))-1 ) = PACK(InData%Fy,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Fy) + DO i1 = LBOUND(InData%Fy,1), UBOUND(InData%Fy,1) + DbKiBuf(Db_Xferred) = InData%Fy(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%Fz) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4180,8 +4590,10 @@ SUBROUTINE MAP_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fz,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Fz)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%Fz))-1 ) = PACK(InData%Fz,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%Fz) + DO i1 = LBOUND(InData%Fz,1), UBOUND(InData%Fz,1) + DbKiBuf(Db_Xferred) = InData%Fz(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutput) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4193,8 +4605,10 @@ SUBROUTINE MAP_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WriteOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WriteOutput))-1 ) = PACK(InData%WriteOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WriteOutput) + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%wrtOutput) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4206,8 +4620,10 @@ SUBROUTINE MAP_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%wrtOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%wrtOutput)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%wrtOutput))-1 ) = PACK(InData%wrtOutput,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%wrtOutput) + DO i1 = LBOUND(InData%wrtOutput,1), UBOUND(InData%wrtOutput,1) + DbKiBuf(Db_Xferred) = InData%wrtOutput(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF CALL MeshPack( InData%ptFairleadLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! ptFairleadLoad CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4252,12 +4668,6 @@ SUBROUTINE MAP_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -4288,15 +4698,10 @@ SUBROUTINE MAP_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs OutData%c_obj%Fx_Len = SIZE(OutData%Fx) IF (OutData%c_obj%Fx_Len > 0) & OutData%c_obj%Fx = C_LOC( OutData%Fx(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Fx)>0) OutData%Fx = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Fx))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%Fx) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Fx,1), UBOUND(OutData%Fx,1) + OutData%Fx(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fy not allocated Int_Xferred = Int_Xferred + 1 @@ -4314,15 +4719,10 @@ SUBROUTINE MAP_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs OutData%c_obj%Fy_Len = SIZE(OutData%Fy) IF (OutData%c_obj%Fy_Len > 0) & OutData%c_obj%Fy = C_LOC( OutData%Fy(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Fy)>0) OutData%Fy = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Fy))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%Fy) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Fy,1), UBOUND(OutData%Fy,1) + OutData%Fy(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Fz not allocated Int_Xferred = Int_Xferred + 1 @@ -4340,15 +4740,10 @@ SUBROUTINE MAP_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs OutData%c_obj%Fz_Len = SIZE(OutData%Fz) IF (OutData%c_obj%Fz_Len > 0) & OutData%c_obj%Fz = C_LOC( OutData%Fz(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Fz)>0) OutData%Fz = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%Fz))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%Fz) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Fz,1), UBOUND(OutData%Fz,1) + OutData%Fz(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutput not allocated Int_Xferred = Int_Xferred + 1 @@ -4363,15 +4758,10 @@ SUBROUTINE MAP_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WriteOutput)>0) OutData%WriteOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WriteOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WriteOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! wrtOutput not allocated Int_Xferred = Int_Xferred + 1 @@ -4389,15 +4779,10 @@ SUBROUTINE MAP_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs OutData%c_obj%wrtOutput_Len = SIZE(OutData%wrtOutput) IF (OutData%c_obj%wrtOutput_Len > 0) & OutData%c_obj%wrtOutput = C_LOC( OutData%wrtOutput(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%wrtOutput)>0) OutData%wrtOutput = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%wrtOutput))-1 ), mask1, 0.0_DbKi ), C_DOUBLE) - Db_Xferred = Db_Xferred + SIZE(OutData%wrtOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%wrtOutput,1), UBOUND(OutData%wrtOutput,1) + OutData%wrtOutput(i1) = REAL(DbKiBuf(Db_Xferred), C_DOUBLE) + Db_Xferred = Db_Xferred + 1 + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -4441,43 +4826,124 @@ SUBROUTINE MAP_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END SUBROUTINE MAP_UnPackOutput - SUBROUTINE MAP_C2Fary_CopyOutput( OutputData, ErrStat, ErrMsg ) + SUBROUTINE MAP_C2Fary_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) TYPE(MAP_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" - ! -- Fx Output Data fields - IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%Fx ) ) THEN - NULLIFY( OutputData%Fx ) + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers ELSE - CALL C_F_POINTER(OutputData%C_obj%Fx, OutputData%Fx, (/OutputData%C_obj%Fx_Len/)) + SkipPointers_local = .false. + END IF + + ! -- Fx Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%Fx ) ) THEN + NULLIFY( OutputData%Fx ) + ELSE + CALL C_F_POINTER(OutputData%C_obj%Fx, OutputData%Fx, (/OutputData%C_obj%Fx_Len/)) + END IF END IF ! -- Fy Output Data fields - IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%Fy ) ) THEN - NULLIFY( OutputData%Fy ) - ELSE - CALL C_F_POINTER(OutputData%C_obj%Fy, OutputData%Fy, (/OutputData%C_obj%Fy_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%Fy ) ) THEN + NULLIFY( OutputData%Fy ) + ELSE + CALL C_F_POINTER(OutputData%C_obj%Fy, OutputData%Fy, (/OutputData%C_obj%Fy_Len/)) + END IF END IF ! -- Fz Output Data fields - IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%Fz ) ) THEN - NULLIFY( OutputData%Fz ) - ELSE - CALL C_F_POINTER(OutputData%C_obj%Fz, OutputData%Fz, (/OutputData%C_obj%Fz_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%Fz ) ) THEN + NULLIFY( OutputData%Fz ) + ELSE + CALL C_F_POINTER(OutputData%C_obj%Fz, OutputData%Fz, (/OutputData%C_obj%Fz_Len/)) + END IF END IF ! -- wrtOutput Output Data fields - IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%wrtOutput ) ) THEN - NULLIFY( OutputData%wrtOutput ) - ELSE - CALL C_F_POINTER(OutputData%C_obj%wrtOutput, OutputData%wrtOutput, (/OutputData%C_obj%wrtOutput_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%wrtOutput ) ) THEN + NULLIFY( OutputData%wrtOutput ) + ELSE + CALL C_F_POINTER(OutputData%C_obj%wrtOutput, OutputData%wrtOutput, (/OutputData%C_obj%wrtOutput_Len/)) + END IF END IF END SUBROUTINE MAP_C2Fary_CopyOutput + SUBROUTINE MAP_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(MAP_OutputType), INTENT(INOUT) :: OutputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + + ! -- Fx Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OutputData%Fx)) THEN + OutputData%c_obj%Fx_Len = 0 + OutputData%c_obj%Fx = C_NULL_PTR + ELSE + OutputData%c_obj%Fx_Len = SIZE(OutputData%Fx) + IF (OutputData%c_obj%Fx_Len > 0) & + OutputData%c_obj%Fx = C_LOC( OutputData%Fx( LBOUND(OutputData%Fx,1) ) ) + END IF + END IF + + ! -- Fy Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OutputData%Fy)) THEN + OutputData%c_obj%Fy_Len = 0 + OutputData%c_obj%Fy = C_NULL_PTR + ELSE + OutputData%c_obj%Fy_Len = SIZE(OutputData%Fy) + IF (OutputData%c_obj%Fy_Len > 0) & + OutputData%c_obj%Fy = C_LOC( OutputData%Fy( LBOUND(OutputData%Fy,1) ) ) + END IF + END IF + + ! -- Fz Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OutputData%Fz)) THEN + OutputData%c_obj%Fz_Len = 0 + OutputData%c_obj%Fz = C_NULL_PTR + ELSE + OutputData%c_obj%Fz_Len = SIZE(OutputData%Fz) + IF (OutputData%c_obj%Fz_Len > 0) & + OutputData%c_obj%Fz = C_LOC( OutputData%Fz( LBOUND(OutputData%Fz,1) ) ) + END IF + END IF + + ! -- wrtOutput Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OutputData%wrtOutput)) THEN + OutputData%c_obj%wrtOutput_Len = 0 + OutputData%c_obj%wrtOutput = C_NULL_PTR + ELSE + OutputData%c_obj%wrtOutput_Len = SIZE(OutputData%wrtOutput) + IF (OutputData%c_obj%wrtOutput_Len > 0) & + OutputData%c_obj%wrtOutput = C_LOC( OutputData%wrtOutput( LBOUND(OutputData%wrtOutput,1) ) ) + END IF + END IF + END SUBROUTINE MAP_F2C_CopyOutput + SUBROUTINE MAP_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) ! @@ -4553,12 +5019,12 @@ SUBROUTINE MAP_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -4571,29 +5037,25 @@ SUBROUTINE MAP_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) IF (ASSOCIATED(u_out%x) .AND. ASSOCIATED(u1%x)) THEN - ALLOCATE(b1(SIZE(u_out%x,1))) - ALLOCATE(c1(SIZE(u_out%x,1))) - b1 = -(u1%x - u2%x)/t(2) - u_out%x = u1%x + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%x,1),UBOUND(u_out%x,1) + b = -(u1%x(i1) - u2%x(i1)) + u_out%x(i1) = u1%x(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%y) .AND. ASSOCIATED(u1%y)) THEN - ALLOCATE(b1(SIZE(u_out%y,1))) - ALLOCATE(c1(SIZE(u_out%y,1))) - b1 = -(u1%y - u2%y)/t(2) - u_out%y = u1%y + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%y,1),UBOUND(u_out%y,1) + b = -(u1%y(i1) - u2%y(i1)) + u_out%y(i1) = u1%y(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%z) .AND. ASSOCIATED(u1%z)) THEN - ALLOCATE(b1(SIZE(u_out%z,1))) - ALLOCATE(c1(SIZE(u_out%z,1))) - b1 = -(u1%z - u2%z)/t(2) - u_out%z = u1%z + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%z,1),UBOUND(u_out%z,1) + b = -(u1%z(i1) - u2%z(i1)) + u_out%z(i1) = u1%z(i1) + b * ScaleFactor + END DO END IF ! check if allocated CALL MeshExtrapInterp1(u1%PtFairDisplacement, u2%PtFairDisplacement, tin, u_out%PtFairDisplacement, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) @@ -4626,13 +5088,14 @@ SUBROUTINE MAP_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Err REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -4651,32 +5114,28 @@ SUBROUTINE MAP_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) IF (ASSOCIATED(u_out%x) .AND. ASSOCIATED(u1%x)) THEN - ALLOCATE(b1(SIZE(u_out%x,1))) - ALLOCATE(c1(SIZE(u_out%x,1))) - b1 = (t(3)**2*(u1%x - u2%x) + t(2)**2*(-u1%x + u3%x))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%x + t(3)*u2%x - t(2)*u3%x ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%x = u1%x + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%x,1),UBOUND(u_out%x,1) + b = (t(3)**2*(u1%x(i1) - u2%x(i1)) + t(2)**2*(-u1%x(i1) + u3%x(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%x(i1) + t(3)*u2%x(i1) - t(2)*u3%x(i1) ) * scaleFactor + u_out%x(i1) = u1%x(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%y) .AND. ASSOCIATED(u1%y)) THEN - ALLOCATE(b1(SIZE(u_out%y,1))) - ALLOCATE(c1(SIZE(u_out%y,1))) - b1 = (t(3)**2*(u1%y - u2%y) + t(2)**2*(-u1%y + u3%y))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%y + t(3)*u2%y - t(2)*u3%y ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%y = u1%y + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%y,1),UBOUND(u_out%y,1) + b = (t(3)**2*(u1%y(i1) - u2%y(i1)) + t(2)**2*(-u1%y(i1) + u3%y(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%y(i1) + t(3)*u2%y(i1) - t(2)*u3%y(i1) ) * scaleFactor + u_out%y(i1) = u1%y(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%z) .AND. ASSOCIATED(u1%z)) THEN - ALLOCATE(b1(SIZE(u_out%z,1))) - ALLOCATE(c1(SIZE(u_out%z,1))) - b1 = (t(3)**2*(u1%z - u2%z) + t(2)**2*(-u1%z + u3%z))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%z + t(3)*u2%z - t(2)*u3%z ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%z = u1%z + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%z,1),UBOUND(u_out%z,1) + b = (t(3)**2*(u1%z(i1) - u2%z(i1)) + t(2)**2*(-u1%z(i1) + u3%z(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%z(i1) + t(3)*u2%z(i1) - t(2)*u3%z(i1) ) * scaleFactor + u_out%z(i1) = u1%z(i1) + b + c * t_out + END DO END IF ! check if allocated CALL MeshExtrapInterp2(u1%PtFairDisplacement, u2%PtFairDisplacement, u3%PtFairDisplacement, tin, u_out%PtFairDisplacement, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) @@ -4757,12 +5216,12 @@ SUBROUTINE MAP_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -4775,45 +5234,37 @@ SUBROUTINE MAP_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) IF (ASSOCIATED(y_out%Fx) .AND. ASSOCIATED(y1%Fx)) THEN - ALLOCATE(b1(SIZE(y_out%Fx,1))) - ALLOCATE(c1(SIZE(y_out%Fx,1))) - b1 = -(y1%Fx - y2%Fx)/t(2) - y_out%Fx = y1%Fx + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%Fx,1),UBOUND(y_out%Fx,1) + b = -(y1%Fx(i1) - y2%Fx(i1)) + y_out%Fx(i1) = y1%Fx(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(y_out%Fy) .AND. ASSOCIATED(y1%Fy)) THEN - ALLOCATE(b1(SIZE(y_out%Fy,1))) - ALLOCATE(c1(SIZE(y_out%Fy,1))) - b1 = -(y1%Fy - y2%Fy)/t(2) - y_out%Fy = y1%Fy + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%Fy,1),UBOUND(y_out%Fy,1) + b = -(y1%Fy(i1) - y2%Fy(i1)) + y_out%Fy(i1) = y1%Fy(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(y_out%Fz) .AND. ASSOCIATED(y1%Fz)) THEN - ALLOCATE(b1(SIZE(y_out%Fz,1))) - ALLOCATE(c1(SIZE(y_out%Fz,1))) - b1 = -(y1%Fz - y2%Fz)/t(2) - y_out%Fz = y1%Fz + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%Fz,1),UBOUND(y_out%Fz,1) + b = -(y1%Fz(i1) - y2%Fz(i1)) + y_out%Fz(i1) = y1%Fz(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = -(y1%WriteOutput - y2%WriteOutput)/t(2) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(y_out%wrtOutput) .AND. ASSOCIATED(y1%wrtOutput)) THEN - ALLOCATE(b1(SIZE(y_out%wrtOutput,1))) - ALLOCATE(c1(SIZE(y_out%wrtOutput,1))) - b1 = -(y1%wrtOutput - y2%wrtOutput)/t(2) - y_out%wrtOutput = y1%wrtOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%wrtOutput,1),UBOUND(y_out%wrtOutput,1) + b = -(y1%wrtOutput(i1) - y2%wrtOutput(i1)) + y_out%wrtOutput(i1) = y1%wrtOutput(i1) + b * ScaleFactor + END DO END IF ! check if allocated CALL MeshExtrapInterp1(y1%ptFairleadLoad, y2%ptFairleadLoad, tin, y_out%ptFairleadLoad, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) @@ -4846,13 +5297,14 @@ SUBROUTINE MAP_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Er REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'MAP_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -4871,50 +5323,42 @@ SUBROUTINE MAP_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) IF (ASSOCIATED(y_out%Fx) .AND. ASSOCIATED(y1%Fx)) THEN - ALLOCATE(b1(SIZE(y_out%Fx,1))) - ALLOCATE(c1(SIZE(y_out%Fx,1))) - b1 = (t(3)**2*(y1%Fx - y2%Fx) + t(2)**2*(-y1%Fx + y3%Fx))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%Fx + t(3)*y2%Fx - t(2)*y3%Fx ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Fx = y1%Fx + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%Fx,1),UBOUND(y_out%Fx,1) + b = (t(3)**2*(y1%Fx(i1) - y2%Fx(i1)) + t(2)**2*(-y1%Fx(i1) + y3%Fx(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%Fx(i1) + t(3)*y2%Fx(i1) - t(2)*y3%Fx(i1) ) * scaleFactor + y_out%Fx(i1) = y1%Fx(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(y_out%Fy) .AND. ASSOCIATED(y1%Fy)) THEN - ALLOCATE(b1(SIZE(y_out%Fy,1))) - ALLOCATE(c1(SIZE(y_out%Fy,1))) - b1 = (t(3)**2*(y1%Fy - y2%Fy) + t(2)**2*(-y1%Fy + y3%Fy))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%Fy + t(3)*y2%Fy - t(2)*y3%Fy ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Fy = y1%Fy + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%Fy,1),UBOUND(y_out%Fy,1) + b = (t(3)**2*(y1%Fy(i1) - y2%Fy(i1)) + t(2)**2*(-y1%Fy(i1) + y3%Fy(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%Fy(i1) + t(3)*y2%Fy(i1) - t(2)*y3%Fy(i1) ) * scaleFactor + y_out%Fy(i1) = y1%Fy(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(y_out%Fz) .AND. ASSOCIATED(y1%Fz)) THEN - ALLOCATE(b1(SIZE(y_out%Fz,1))) - ALLOCATE(c1(SIZE(y_out%Fz,1))) - b1 = (t(3)**2*(y1%Fz - y2%Fz) + t(2)**2*(-y1%Fz + y3%Fz))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%Fz + t(3)*y2%Fz - t(2)*y3%Fz ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%Fz = y1%Fz + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%Fz,1),UBOUND(y_out%Fz,1) + b = (t(3)**2*(y1%Fz(i1) - y2%Fz(i1)) + t(2)**2*(-y1%Fz(i1) + y3%Fz(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%Fz(i1) + t(3)*y2%Fz(i1) - t(2)*y3%Fz(i1) ) * scaleFactor + y_out%Fz(i1) = y1%Fz(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = (t(3)**2*(y1%WriteOutput - y2%WriteOutput) + t(2)**2*(-y1%WriteOutput + y3%WriteOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WriteOutput + t(3)*y2%WriteOutput - t(2)*y3%WriteOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(y_out%wrtOutput) .AND. ASSOCIATED(y1%wrtOutput)) THEN - ALLOCATE(b1(SIZE(y_out%wrtOutput,1))) - ALLOCATE(c1(SIZE(y_out%wrtOutput,1))) - b1 = (t(3)**2*(y1%wrtOutput - y2%wrtOutput) + t(2)**2*(-y1%wrtOutput + y3%wrtOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%wrtOutput + t(3)*y2%wrtOutput - t(2)*y3%wrtOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%wrtOutput = y1%wrtOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%wrtOutput,1),UBOUND(y_out%wrtOutput,1) + b = (t(3)**2*(y1%wrtOutput(i1) - y2%wrtOutput(i1)) + t(2)**2*(-y1%wrtOutput(i1) + y3%wrtOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%wrtOutput(i1) + t(3)*y2%wrtOutput(i1) - t(2)*y3%wrtOutput(i1) ) * scaleFactor + y_out%wrtOutput(i1) = y1%wrtOutput(i1) + b + c * t_out + END DO END IF ! check if allocated CALL MeshExtrapInterp2(y1%ptFairleadLoad, y2%ptFairleadLoad, y3%ptFairleadLoad, tin, y_out%ptFairleadLoad, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) diff --git a/modules/moordyn/src/MoorDyn_IO.f90 b/modules/moordyn/src/MoorDyn_IO.f90 index ad25b1ced3..aca3d57559 100644 --- a/modules/moordyn/src/MoorDyn_IO.f90 +++ b/modules/moordyn/src/MoorDyn_IO.f90 @@ -908,7 +908,7 @@ SUBROUTINE MDIO_OpenOutput( OutRootName, p, m, InitOut, ErrStat, ErrMsg ) INTEGER :: I ! Generic loop counter INTEGER :: J ! Generic loop counter CHARACTER(1024) :: OutFileName ! The name of the output file including the full path. - INTEGER :: L ! counter for index in LineWrOutput +! INTEGER :: L ! counter for index in LineWrOutput INTEGER :: LineNumOuts ! number of entries in LineWrOutput for each line CHARACTER(200) :: Frmt ! a string to hold a format statement INTEGER :: ErrStat2 diff --git a/modules/moordyn/src/MoorDyn_Registry.txt b/modules/moordyn/src/MoorDyn_Registry.txt index 1649418de8..35e63e8cfd 100644 --- a/modules/moordyn/src/MoorDyn_Registry.txt +++ b/modules/moordyn/src/MoorDyn_Registry.txt @@ -98,8 +98,8 @@ typedef ^ ^ ReKi LineWrOutput {:} # this is the MDOutParmType - a less literal alternative of the NWTC OutParmType for MoorDyn (to avoid huge lists of possible output channel permutations) -typedef ^ MD_OutParmType CHARACTER(10) Name - - - "name of output channel" -typedef ^ ^ CHARACTER(10) Units - - - "units string" +typedef ^ MD_OutParmType CHARACTER(ChanLen) Name - - - "name of output channel" +typedef ^ ^ CHARACTER(ChanLen) Units - - - "units string" typedef ^ ^ IntKi QType - - - "type of quantity - 0=tension, 1=x, 2=y, 3=z..." typedef ^ ^ IntKi OType - - - "type of object - 0=line, 1=connect" typedef ^ ^ IntKi NodeID - - - "node number if OType=0. 0=anchor, -1=N=Fairlead" diff --git a/modules/moordyn/src/MoorDyn_Types.f90 b/modules/moordyn/src/MoorDyn_Types.f90 index aa295f80ec..d9e507a624 100644 --- a/modules/moordyn/src/MoorDyn_Types.f90 +++ b/modules/moordyn/src/MoorDyn_Types.f90 @@ -122,8 +122,8 @@ MODULE MoorDyn_Types ! ======================= ! ========= MD_OutParmType ======= TYPE, PUBLIC :: MD_OutParmType - CHARACTER(10) :: Name !< name of output channel [-] - CHARACTER(10) :: Units !< units string [-] + CHARACTER(ChanLen) :: Name !< name of output channel [-] + CHARACTER(ChanLen) :: Units !< units string [-] INTEGER(IntKi) :: QType !< type of quantity - 0=tension, 1=x, 2=y, 3=z... [-] INTEGER(IntKi) :: OType !< type of object - 0=line, 1=connect [-] INTEGER(IntKi) :: NodeID !< node number if OType=0. 0=anchor, -1=N=Fairlead [-] @@ -336,32 +336,34 @@ SUBROUTINE MD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%g - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rhoW - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WtrDepth - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PtfmInit))-1 ) = PACK(InData%PtfmInit,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PtfmInit) - DO I = 1, LEN(InData%FileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%FileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Echo , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DTIC - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMaxIC - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%CdScaleIC - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%threshIC - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%g + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rhoW + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDepth + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%PtfmInit,1), UBOUND(InData%PtfmInit,1) + ReKiBuf(Re_Xferred) = InData%PtfmInit(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO I = 1, LEN(InData%FileName) + IntKiBuf(Int_Xferred) = ICHAR(InData%FileName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%Echo, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DTIC + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMaxIC + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%CdScaleIC + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%threshIC + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%OutList) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -372,12 +374,12 @@ SUBROUTINE MD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutList,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) + DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) DO I = 1, LEN(InData%OutList) IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF END SUBROUTINE MD_PackInitInput @@ -394,12 +396,6 @@ SUBROUTINE MD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (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 @@ -416,41 +412,36 @@ SUBROUTINE MD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%g = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rhoW = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDepth = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%g = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rhoW = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WtrDepth = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%PtfmInit,1) i1_u = UBOUND(OutData%PtfmInit,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%PtfmInit = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PtfmInit))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PtfmInit) - DEALLOCATE(mask1) - DO I = 1, LEN(OutData%FileName) - OutData%FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%Echo = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%DTIC = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMaxIC = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%CdScaleIC = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%threshIC = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%PtfmInit,1), UBOUND(OutData%PtfmInit,1) + OutData%PtfmInit(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + DO I = 1, LEN(OutData%FileName) + OutData%FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%Echo = TRANSFER(IntKiBuf(Int_Xferred), OutData%Echo) + Int_Xferred = Int_Xferred + 1 + OutData%DTIC = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMaxIC = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%CdScaleIC = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%threshIC = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutList not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -464,19 +455,12 @@ SUBROUTINE MD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) + DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) DO I = 1, LEN(OutData%OutList) OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF END SUBROUTINE MD_UnPackInitInput @@ -589,28 +573,28 @@ SUBROUTINE MD_PackLineProp( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%IdNum - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%name) - IntKiBuf(Int_Xferred) = ICHAR(InData%name(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%d - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%w - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%EA - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%BA - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Can - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cat - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cdn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Cdt - Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%IdNum + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%name) + IntKiBuf(Int_Xferred) = ICHAR(InData%name(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + ReKiBuf(Re_Xferred) = InData%d + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%w + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%EA + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%BA + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Can + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cat + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cdn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Cdt + Re_Xferred = Re_Xferred + 1 END SUBROUTINE MD_PackLineProp SUBROUTINE MD_UnPackLineProp( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -626,12 +610,6 @@ SUBROUTINE MD_UnPackLineProp( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackLineProp' @@ -645,28 +623,28 @@ SUBROUTINE MD_UnPackLineProp( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%IdNum = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%name) - OutData%name(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%d = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%w = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%EA = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%BA = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Can = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cat = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cdn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Cdt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%IdNum = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%name) + OutData%name(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%d = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%w = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%EA = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%BA = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Can = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cat = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cdn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Cdt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE MD_UnPackLineProp SUBROUTINE MD_CopyConnect( SrcConnectData, DstConnectData, CtrlCode, ErrStat, ErrMsg ) @@ -836,14 +814,14 @@ SUBROUTINE MD_PackConnect( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%IdNum - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%type) - IntKiBuf(Int_Xferred) = ICHAR(InData%type(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TypeNum - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%IdNum + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%type) + IntKiBuf(Int_Xferred) = ICHAR(InData%type(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%TypeNum + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%AttachedFairs) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -854,8 +832,10 @@ SUBROUTINE MD_PackConnect( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AttachedFairs,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AttachedFairs)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%AttachedFairs))-1 ) = PACK(InData%AttachedFairs,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%AttachedFairs) + DO i1 = LBOUND(InData%AttachedFairs,1), UBOUND(InData%AttachedFairs,1) + IntKiBuf(Int_Xferred) = InData%AttachedFairs(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%AttachedAnchs) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -867,39 +847,55 @@ SUBROUTINE MD_PackConnect( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AttachedAnchs,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AttachedAnchs)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%AttachedAnchs))-1 ) = PACK(InData%AttachedAnchs,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%AttachedAnchs) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%conX - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%conY - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%conZ - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%conM - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%conV - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%conFX - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%conFY - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%conFZ - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%conCa - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%conCdA - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Ftot))-1 ) = PACK(InData%Ftot,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Ftot) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Mtot))-1 ) = PACK(InData%Mtot,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Mtot) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%S))-1 ) = PACK(InData%S,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%S) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%r))-1 ) = PACK(InData%r,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%r) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%rd))-1 ) = PACK(InData%rd,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%rd) + DO i1 = LBOUND(InData%AttachedAnchs,1), UBOUND(InData%AttachedAnchs,1) + IntKiBuf(Int_Xferred) = InData%AttachedAnchs(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%conX + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%conY + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%conZ + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%conM + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%conV + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%conFX + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%conFY + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%conFZ + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%conCa + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%conCdA + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%Ftot,1), UBOUND(InData%Ftot,1) + ReKiBuf(Re_Xferred) = InData%Ftot(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i2 = LBOUND(InData%Mtot,2), UBOUND(InData%Mtot,2) + DO i1 = LBOUND(InData%Mtot,1), UBOUND(InData%Mtot,1) + ReKiBuf(Re_Xferred) = InData%Mtot(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i2 = LBOUND(InData%S,2), UBOUND(InData%S,2) + DO i1 = LBOUND(InData%S,1), UBOUND(InData%S,1) + ReKiBuf(Re_Xferred) = InData%S(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i1 = LBOUND(InData%r,1), UBOUND(InData%r,1) + ReKiBuf(Re_Xferred) = InData%r(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%rd,1), UBOUND(InData%rd,1) + ReKiBuf(Re_Xferred) = InData%rd(i1) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE MD_PackConnect SUBROUTINE MD_UnPackConnect( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -915,12 +911,6 @@ SUBROUTINE MD_UnPackConnect( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -936,14 +926,14 @@ SUBROUTINE MD_UnPackConnect( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%IdNum = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%type) - OutData%type(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%TypeNum = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%IdNum = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%type) + OutData%type(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%TypeNum = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AttachedFairs not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -957,15 +947,10 @@ SUBROUTINE MD_UnPackConnect( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AttachedFairs.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%AttachedFairs)>0) OutData%AttachedFairs = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%AttachedFairs))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%AttachedFairs) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AttachedFairs,1), UBOUND(OutData%AttachedFairs,1) + OutData%AttachedFairs(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AttachedAnchs not allocated Int_Xferred = Int_Xferred + 1 @@ -980,95 +965,69 @@ SUBROUTINE MD_UnPackConnect( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AttachedAnchs.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%AttachedAnchs)>0) OutData%AttachedAnchs = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%AttachedAnchs))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%AttachedAnchs) - DEALLOCATE(mask1) - END IF - OutData%conX = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%conY = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%conZ = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%conM = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%conV = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%conFX = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%conFY = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%conFZ = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%conCa = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%conCdA = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%AttachedAnchs,1), UBOUND(OutData%AttachedAnchs,1) + OutData%AttachedAnchs(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + OutData%conX = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%conY = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%conZ = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%conM = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%conV = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%conFX = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%conFY = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%conFZ = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%conCa = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%conCdA = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%Ftot,1) i1_u = UBOUND(OutData%Ftot,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%Ftot = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Ftot))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Ftot) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Ftot,1), UBOUND(OutData%Ftot,1) + OutData%Ftot(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%Mtot,1) i1_u = UBOUND(OutData%Mtot,1) i2_l = LBOUND(OutData%Mtot,2) i2_u = UBOUND(OutData%Mtot,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%Mtot = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Mtot))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Mtot) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Mtot,2), UBOUND(OutData%Mtot,2) + DO i1 = LBOUND(OutData%Mtot,1), UBOUND(OutData%Mtot,1) + OutData%Mtot(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%S,1) i1_u = UBOUND(OutData%S,1) i2_l = LBOUND(OutData%S,2) i2_u = UBOUND(OutData%S,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%S = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%S))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%S) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%S,2), UBOUND(OutData%S,2) + DO i1 = LBOUND(OutData%S,1), UBOUND(OutData%S,1) + OutData%S(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%r,1) i1_u = UBOUND(OutData%r,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%r = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%r))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%r) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%r,1), UBOUND(OutData%r,1) + OutData%r(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%rd,1) i1_u = UBOUND(OutData%rd,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%rd = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%rd))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%rd) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%rd,1), UBOUND(OutData%rd,1) + OutData%rd(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE MD_UnPackConnect SUBROUTINE MD_CopyLine( SrcLineData, DstLineData, CtrlCode, ErrStat, ErrMsg ) @@ -1595,26 +1554,28 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%IdNum - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%type) - IntKiBuf(Int_Xferred) = ICHAR(InData%type(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%OutFlagList))-1 ) = PACK(InData%OutFlagList,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%OutFlagList) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%FairConnect - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%AnchConnect - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%PropsIdNum - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%N - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%UnstrLen - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%BA - Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%IdNum + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%type) + IntKiBuf(Int_Xferred) = ICHAR(InData%type(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO i1 = LBOUND(InData%OutFlagList,1), UBOUND(InData%OutFlagList,1) + IntKiBuf(Int_Xferred) = InData%OutFlagList(i1) + Int_Xferred = Int_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%FairConnect + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%AnchConnect + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%PropsIdNum + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%N + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%UnstrLen + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%BA + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%r) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1628,8 +1589,12 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%r,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%r)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%r))-1 ) = PACK(InData%r,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%r) + DO i2 = LBOUND(InData%r,2), UBOUND(InData%r,2) + DO i1 = LBOUND(InData%r,1), UBOUND(InData%r,1) + ReKiBuf(Re_Xferred) = InData%r(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%rd) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1644,8 +1609,12 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%rd,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%rd)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%rd))-1 ) = PACK(InData%rd,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%rd) + DO i2 = LBOUND(InData%rd,2), UBOUND(InData%rd,2) + DO i1 = LBOUND(InData%rd,1), UBOUND(InData%rd,1) + ReKiBuf(Re_Xferred) = InData%rd(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%q) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1660,8 +1629,12 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%q,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%q)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%q))-1 ) = PACK(InData%q,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%q) + DO i2 = LBOUND(InData%q,2), UBOUND(InData%q,2) + DO i1 = LBOUND(InData%q,1), UBOUND(InData%q,1) + ReKiBuf(Re_Xferred) = InData%q(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%l) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1673,8 +1646,10 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%l,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%l)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%l))-1 ) = PACK(InData%l,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%l) + DO i1 = LBOUND(InData%l,1), UBOUND(InData%l,1) + ReKiBuf(Re_Xferred) = InData%l(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%lstr) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1686,8 +1661,10 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%lstr,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%lstr)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%lstr))-1 ) = PACK(InData%lstr,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%lstr) + DO i1 = LBOUND(InData%lstr,1), UBOUND(InData%lstr,1) + ReKiBuf(Re_Xferred) = InData%lstr(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%lstrd) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1699,8 +1676,10 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%lstrd,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%lstrd)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%lstrd))-1 ) = PACK(InData%lstrd,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%lstrd) + DO i1 = LBOUND(InData%lstrd,1), UBOUND(InData%lstrd,1) + ReKiBuf(Re_Xferred) = InData%lstrd(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%V) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1712,8 +1691,10 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%V,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%V)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%V))-1 ) = PACK(InData%V,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%V) + DO i1 = LBOUND(InData%V,1), UBOUND(InData%V,1) + ReKiBuf(Re_Xferred) = InData%V(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%T) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1728,8 +1709,12 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%T,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%T)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%T))-1 ) = PACK(InData%T,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%T) + DO i2 = LBOUND(InData%T,2), UBOUND(InData%T,2) + DO i1 = LBOUND(InData%T,1), UBOUND(InData%T,1) + ReKiBuf(Re_Xferred) = InData%T(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Td) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1744,8 +1729,12 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Td,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Td)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Td))-1 ) = PACK(InData%Td,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Td) + DO i2 = LBOUND(InData%Td,2), UBOUND(InData%Td,2) + DO i1 = LBOUND(InData%Td,1), UBOUND(InData%Td,1) + ReKiBuf(Re_Xferred) = InData%Td(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%W) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1760,8 +1749,12 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%W,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%W)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%W))-1 ) = PACK(InData%W,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%W) + DO i2 = LBOUND(InData%W,2), UBOUND(InData%W,2) + DO i1 = LBOUND(InData%W,1), UBOUND(InData%W,1) + ReKiBuf(Re_Xferred) = InData%W(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Dp) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1776,8 +1769,12 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Dp,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Dp)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Dp))-1 ) = PACK(InData%Dp,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Dp) + DO i2 = LBOUND(InData%Dp,2), UBOUND(InData%Dp,2) + DO i1 = LBOUND(InData%Dp,1), UBOUND(InData%Dp,1) + ReKiBuf(Re_Xferred) = InData%Dp(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Dq) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1792,8 +1789,12 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Dq,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Dq)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Dq))-1 ) = PACK(InData%Dq,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Dq) + DO i2 = LBOUND(InData%Dq,2), UBOUND(InData%Dq,2) + DO i1 = LBOUND(InData%Dq,1), UBOUND(InData%Dq,1) + ReKiBuf(Re_Xferred) = InData%Dq(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Ap) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1808,8 +1809,12 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ap,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Ap)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Ap))-1 ) = PACK(InData%Ap,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Ap) + DO i2 = LBOUND(InData%Ap,2), UBOUND(InData%Ap,2) + DO i1 = LBOUND(InData%Ap,1), UBOUND(InData%Ap,1) + ReKiBuf(Re_Xferred) = InData%Ap(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Aq) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1824,8 +1829,12 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Aq,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Aq)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Aq))-1 ) = PACK(InData%Aq,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Aq) + DO i2 = LBOUND(InData%Aq,2), UBOUND(InData%Aq,2) + DO i1 = LBOUND(InData%Aq,1), UBOUND(InData%Aq,1) + ReKiBuf(Re_Xferred) = InData%Aq(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%B) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1840,8 +1849,12 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%B,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%B)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%B))-1 ) = PACK(InData%B,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%B) + DO i2 = LBOUND(InData%B,2), UBOUND(InData%B,2) + DO i1 = LBOUND(InData%B,1), UBOUND(InData%B,1) + ReKiBuf(Re_Xferred) = InData%B(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%F) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1856,8 +1869,12 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%F)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F))-1 ) = PACK(InData%F,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F) + DO i2 = LBOUND(InData%F,2), UBOUND(InData%F,2) + DO i1 = LBOUND(InData%F,1), UBOUND(InData%F,1) + ReKiBuf(Re_Xferred) = InData%F(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%S) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1875,8 +1892,14 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%S,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%S)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%S))-1 ) = PACK(InData%S,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%S) + DO i3 = LBOUND(InData%S,3), UBOUND(InData%S,3) + DO i2 = LBOUND(InData%S,2), UBOUND(InData%S,2) + DO i1 = LBOUND(InData%S,1), UBOUND(InData%S,1) + ReKiBuf(Re_Xferred) = InData%S(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%M) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1894,11 +1917,17 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%M)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%M))-1 ) = PACK(InData%M,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%M) + DO i3 = LBOUND(InData%M,3), UBOUND(InData%M,3) + DO i2 = LBOUND(InData%M,2), UBOUND(InData%M,2) + DO i1 = LBOUND(InData%M,1), UBOUND(InData%M,1) + ReKiBuf(Re_Xferred) = InData%M(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%LineUnOut - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%LineUnOut + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%LineWrOutput) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1909,8 +1938,10 @@ SUBROUTINE MD_PackLine( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LineWrOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LineWrOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LineWrOutput))-1 ) = PACK(InData%LineWrOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LineWrOutput) + DO i1 = LBOUND(InData%LineWrOutput,1), UBOUND(InData%LineWrOutput,1) + ReKiBuf(Re_Xferred) = InData%LineWrOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE MD_PackLine @@ -1927,12 +1958,6 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (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 @@ -1949,35 +1974,30 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%IdNum = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%type) - OutData%type(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + OutData%IdNum = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%type) + OutData%type(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I i1_l = LBOUND(OutData%OutFlagList,1) i1_u = UBOUND(OutData%OutFlagList,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%OutFlagList = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%OutFlagList))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%OutFlagList) - DEALLOCATE(mask1) - OutData%FairConnect = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%AnchConnect = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%PropsIdNum = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%N = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%UnstrLen = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%BA = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%OutFlagList,1), UBOUND(OutData%OutFlagList,1) + OutData%OutFlagList(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + OutData%FairConnect = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%AnchConnect = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%PropsIdNum = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%N = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%UnstrLen = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%BA = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! r not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1994,15 +2014,12 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%r.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%r)>0) OutData%r = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%r))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%r) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%r,2), UBOUND(OutData%r,2) + DO i1 = LBOUND(OutData%r,1), UBOUND(OutData%r,1) + OutData%r(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! rd not allocated Int_Xferred = Int_Xferred + 1 @@ -2020,15 +2037,12 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%rd.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%rd)>0) OutData%rd = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%rd))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%rd) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%rd,2), UBOUND(OutData%rd,2) + DO i1 = LBOUND(OutData%rd,1), UBOUND(OutData%rd,1) + OutData%rd(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! q not allocated Int_Xferred = Int_Xferred + 1 @@ -2046,15 +2060,12 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%q.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%q)>0) OutData%q = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%q))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%q) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%q,2), UBOUND(OutData%q,2) + DO i1 = LBOUND(OutData%q,1), UBOUND(OutData%q,1) + OutData%q(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! l not allocated Int_Xferred = Int_Xferred + 1 @@ -2069,15 +2080,10 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%l.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%l)>0) OutData%l = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%l))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%l) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%l,1), UBOUND(OutData%l,1) + OutData%l(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! lstr not allocated Int_Xferred = Int_Xferred + 1 @@ -2092,15 +2098,10 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%lstr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%lstr)>0) OutData%lstr = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%lstr))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%lstr) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%lstr,1), UBOUND(OutData%lstr,1) + OutData%lstr(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! lstrd not allocated Int_Xferred = Int_Xferred + 1 @@ -2115,15 +2116,10 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%lstrd.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%lstrd)>0) OutData%lstrd = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%lstrd))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%lstrd) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%lstrd,1), UBOUND(OutData%lstrd,1) + OutData%lstrd(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! V not allocated Int_Xferred = Int_Xferred + 1 @@ -2138,15 +2134,10 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%V.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%V)>0) OutData%V = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%V))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%V) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%V,1), UBOUND(OutData%V,1) + OutData%V(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! T not allocated Int_Xferred = Int_Xferred + 1 @@ -2164,15 +2155,12 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%T.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%T)>0) OutData%T = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%T))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%T) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%T,2), UBOUND(OutData%T,2) + DO i1 = LBOUND(OutData%T,1), UBOUND(OutData%T,1) + OutData%T(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Td not allocated Int_Xferred = Int_Xferred + 1 @@ -2190,15 +2178,12 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Td.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Td)>0) OutData%Td = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Td))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Td) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Td,2), UBOUND(OutData%Td,2) + DO i1 = LBOUND(OutData%Td,1), UBOUND(OutData%Td,1) + OutData%Td(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! W not allocated Int_Xferred = Int_Xferred + 1 @@ -2216,15 +2201,12 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%W.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%W)>0) OutData%W = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%W))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%W) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%W,2), UBOUND(OutData%W,2) + DO i1 = LBOUND(OutData%W,1), UBOUND(OutData%W,1) + OutData%W(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Dp not allocated Int_Xferred = Int_Xferred + 1 @@ -2242,15 +2224,12 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Dp.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Dp)>0) OutData%Dp = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Dp))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Dp) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Dp,2), UBOUND(OutData%Dp,2) + DO i1 = LBOUND(OutData%Dp,1), UBOUND(OutData%Dp,1) + OutData%Dp(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Dq not allocated Int_Xferred = Int_Xferred + 1 @@ -2268,15 +2247,12 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Dq.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Dq)>0) OutData%Dq = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Dq))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Dq) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Dq,2), UBOUND(OutData%Dq,2) + DO i1 = LBOUND(OutData%Dq,1), UBOUND(OutData%Dq,1) + OutData%Dq(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Ap not allocated Int_Xferred = Int_Xferred + 1 @@ -2294,15 +2270,12 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ap.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Ap)>0) OutData%Ap = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Ap))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Ap) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Ap,2), UBOUND(OutData%Ap,2) + DO i1 = LBOUND(OutData%Ap,1), UBOUND(OutData%Ap,1) + OutData%Ap(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Aq not allocated Int_Xferred = Int_Xferred + 1 @@ -2320,15 +2293,12 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Aq.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Aq)>0) OutData%Aq = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Aq))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Aq) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Aq,2), UBOUND(OutData%Aq,2) + DO i1 = LBOUND(OutData%Aq,1), UBOUND(OutData%Aq,1) + OutData%Aq(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! B not allocated Int_Xferred = Int_Xferred + 1 @@ -2346,15 +2316,12 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%B.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%B)>0) OutData%B = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%B))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%B) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%B,2), UBOUND(OutData%B,2) + DO i1 = LBOUND(OutData%B,1), UBOUND(OutData%B,1) + OutData%B(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F not allocated Int_Xferred = Int_Xferred + 1 @@ -2372,15 +2339,12 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%F)>0) OutData%F = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%F,2), UBOUND(OutData%F,2) + DO i1 = LBOUND(OutData%F,1), UBOUND(OutData%F,1) + OutData%F(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! S not allocated Int_Xferred = Int_Xferred + 1 @@ -2401,15 +2365,14 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%S.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%S)>0) OutData%S = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%S))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%S) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%S,3), UBOUND(OutData%S,3) + DO i2 = LBOUND(OutData%S,2), UBOUND(OutData%S,2) + DO i1 = LBOUND(OutData%S,1), UBOUND(OutData%S,1) + OutData%S(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! M not allocated Int_Xferred = Int_Xferred + 1 @@ -2430,18 +2393,17 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%M.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%M)>0) OutData%M = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%M))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%M) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%M,3), UBOUND(OutData%M,3) + DO i2 = LBOUND(OutData%M,2), UBOUND(OutData%M,2) + DO i1 = LBOUND(OutData%M,1), UBOUND(OutData%M,1) + OutData%M(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF - OutData%LineUnOut = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%LineUnOut = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LineWrOutput not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -2455,15 +2417,10 @@ SUBROUTINE MD_UnPackLine( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineWrOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LineWrOutput)>0) OutData%LineWrOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LineWrOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LineWrOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LineWrOutput,1), UBOUND(OutData%LineWrOutput,1) + OutData%LineWrOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE MD_UnPackLine @@ -2568,22 +2525,22 @@ SUBROUTINE MD_PackOutParmType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%Name) - IntKiBuf(Int_Xferred) = ICHAR(InData%Name(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%Units) - IntKiBuf(Int_Xferred) = ICHAR(InData%Units(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%QType - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%OType - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NodeID - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%ObjID - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%Name) + IntKiBuf(Int_Xferred) = ICHAR(InData%Name(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%Units) + IntKiBuf(Int_Xferred) = ICHAR(InData%Units(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%QType + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%OType + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NodeID + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%ObjID + Int_Xferred = Int_Xferred + 1 END SUBROUTINE MD_PackOutParmType SUBROUTINE MD_UnPackOutParmType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2599,12 +2556,6 @@ SUBROUTINE MD_UnPackOutParmType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackOutParmType' @@ -2618,22 +2569,22 @@ SUBROUTINE MD_UnPackOutParmType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%Name) - OutData%Name(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Units) - OutData%Units(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%QType = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%OType = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NodeID = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%ObjID = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%Name) + OutData%Name(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%Units) + OutData%Units(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%QType = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%OType = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NodeID = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ObjID = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE MD_UnPackOutParmType SUBROUTINE MD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -2798,12 +2749,12 @@ SUBROUTINE MD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%writeOutputHdr,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%writeOutputHdr,1), UBOUND(InData%writeOutputHdr,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%writeOutputUnt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2815,12 +2766,12 @@ SUBROUTINE MD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%writeOutputUnt,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%writeOutputUnt,1), UBOUND(InData%writeOutputUnt,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + 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) @@ -2865,12 +2816,6 @@ SUBROUTINE MD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -2898,19 +2843,12 @@ SUBROUTINE MD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%writeOutputHdr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%writeOutputHdr,1), UBOUND(OutData%writeOutputHdr,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! writeOutputUnt not allocated Int_Xferred = Int_Xferred + 1 @@ -2925,19 +2863,12 @@ SUBROUTINE MD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%writeOutputUnt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%writeOutputUnt,1), UBOUND(OutData%writeOutputUnt,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -3101,8 +3032,10 @@ SUBROUTINE MD_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%states,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%states)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%states))-1 ) = PACK(InData%states,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%states) + DO i1 = LBOUND(InData%states,1), UBOUND(InData%states,1) + ReKiBuf(Re_Xferred) = InData%states(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE MD_PackContState @@ -3119,12 +3052,6 @@ SUBROUTINE MD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -3152,15 +3079,10 @@ SUBROUTINE MD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%states.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%states)>0) OutData%states = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%states))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%states) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%states,1), UBOUND(OutData%states,1) + OutData%states(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE MD_UnPackContState @@ -3255,8 +3177,8 @@ SUBROUTINE MD_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dummy - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%dummy + Re_Xferred = Re_Xferred + 1 END SUBROUTINE MD_PackDiscState SUBROUTINE MD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -3272,12 +3194,6 @@ SUBROUTINE MD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackDiscState' @@ -3291,8 +3207,8 @@ SUBROUTINE MD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%dummy = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%dummy = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE MD_UnPackDiscState SUBROUTINE MD_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) @@ -3386,8 +3302,8 @@ SUBROUTINE MD_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dummy - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%dummy + Re_Xferred = Re_Xferred + 1 END SUBROUTINE MD_PackConstrState SUBROUTINE MD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -3403,12 +3319,6 @@ SUBROUTINE MD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackConstrState' @@ -3422,8 +3332,8 @@ SUBROUTINE MD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%dummy = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%dummy = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE MD_UnPackConstrState SUBROUTINE MD_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -3517,8 +3427,8 @@ SUBROUTINE MD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dummy - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%dummy + Re_Xferred = Re_Xferred + 1 END SUBROUTINE MD_PackOtherState SUBROUTINE MD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -3534,12 +3444,6 @@ SUBROUTINE MD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackOtherState' @@ -3553,8 +3457,8 @@ SUBROUTINE MD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%dummy = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%dummy = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE MD_UnPackOtherState SUBROUTINE MD_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) @@ -3996,8 +3900,10 @@ SUBROUTINE MD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FairIdList,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FairIdList)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%FairIdList))-1 ) = PACK(InData%FairIdList,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%FairIdList) + DO i1 = LBOUND(InData%FairIdList,1), UBOUND(InData%FairIdList,1) + IntKiBuf(Int_Xferred) = InData%FairIdList(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%ConnIdList) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4009,8 +3915,10 @@ SUBROUTINE MD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ConnIdList,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ConnIdList)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%ConnIdList))-1 ) = PACK(InData%ConnIdList,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%ConnIdList) + DO i1 = LBOUND(InData%ConnIdList,1), UBOUND(InData%ConnIdList,1) + IntKiBuf(Int_Xferred) = InData%ConnIdList(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LineStateIndList) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4022,8 +3930,10 @@ SUBROUTINE MD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LineStateIndList,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LineStateIndList)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%LineStateIndList))-1 ) = PACK(InData%LineStateIndList,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%LineStateIndList) + DO i1 = LBOUND(InData%LineStateIndList,1), UBOUND(InData%LineStateIndList,1) + IntKiBuf(Int_Xferred) = InData%LineStateIndList(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%MDWrOutput) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4035,8 +3945,10 @@ SUBROUTINE MD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MDWrOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%MDWrOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MDWrOutput))-1 ) = PACK(InData%MDWrOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MDWrOutput) + DO i1 = LBOUND(InData%MDWrOutput,1), UBOUND(InData%MDWrOutput,1) + ReKiBuf(Re_Xferred) = InData%MDWrOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE MD_PackMisc @@ -4053,12 +3965,6 @@ SUBROUTINE MD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -4254,15 +4160,10 @@ SUBROUTINE MD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FairIdList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%FairIdList)>0) OutData%FairIdList = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%FairIdList))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%FairIdList) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FairIdList,1), UBOUND(OutData%FairIdList,1) + OutData%FairIdList(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ConnIdList not allocated Int_Xferred = Int_Xferred + 1 @@ -4277,15 +4178,10 @@ SUBROUTINE MD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ConnIdList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%ConnIdList)>0) OutData%ConnIdList = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%ConnIdList))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%ConnIdList) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%ConnIdList,1), UBOUND(OutData%ConnIdList,1) + OutData%ConnIdList(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LineStateIndList not allocated Int_Xferred = Int_Xferred + 1 @@ -4300,15 +4196,10 @@ SUBROUTINE MD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LineStateIndList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LineStateIndList)>0) OutData%LineStateIndList = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%LineStateIndList))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%LineStateIndList) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LineStateIndList,1), UBOUND(OutData%LineStateIndList,1) + OutData%LineStateIndList(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MDWrOutput not allocated Int_Xferred = Int_Xferred + 1 @@ -4323,15 +4214,10 @@ SUBROUTINE MD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MDWrOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%MDWrOutput)>0) OutData%MDWrOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MDWrOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%MDWrOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%MDWrOutput,1), UBOUND(OutData%MDWrOutput,1) + OutData%MDWrOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE MD_UnPackMisc @@ -4505,38 +4391,38 @@ SUBROUTINE MD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NTypes - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NConnects - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NFairs - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NConns - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NAnchs - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NLines - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%g - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%rhoW - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%kBot - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%cBot - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dtM0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%dtCoupling - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + IntKiBuf(Int_Xferred) = InData%NTypes + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NConnects + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NFairs + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NConns + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NAnchs + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NLines + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%g + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%rhoW + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WtrDpth + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%kBot + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%cBot + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%dtM0 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%dtCoupling + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( .NOT. ALLOCATED(InData%OutParam) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4578,12 +4464,12 @@ SUBROUTINE MD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si ENDIF END DO END IF - DO I = 1, LEN(InData%Delim) - IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MDUnOut - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%Delim) + IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%MDUnOut + Int_Xferred = Int_Xferred + 1 END SUBROUTINE MD_PackParam SUBROUTINE MD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -4599,12 +4485,6 @@ SUBROUTINE MD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -4619,38 +4499,38 @@ SUBROUTINE MD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%NTypes = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NConnects = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NFairs = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NConns = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NAnchs = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NLines = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%g = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%rhoW = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%WtrDpth = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%kBot = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%cBot = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%dtM0 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%dtCoupling = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + OutData%NTypes = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NConnects = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NFairs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NConns = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NAnchs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NLines = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%g = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%rhoW = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WtrDpth = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%kBot = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%cBot = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%dtM0 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%dtCoupling = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParam not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -4707,12 +4587,12 @@ SUBROUTINE MD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - DO I = 1, LEN(OutData%Delim) - OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%MDUnOut = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%Delim) + OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%MDUnOut = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE MD_UnPackParam SUBROUTINE MD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -4869,12 +4749,6 @@ SUBROUTINE MD_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'MD_UnPackInput' @@ -5100,8 +4974,10 @@ SUBROUTINE MD_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WriteOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WriteOutput))-1 ) = PACK(InData%WriteOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WriteOutput) + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE MD_PackOutput @@ -5118,12 +4994,6 @@ SUBROUTINE MD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -5191,15 +5061,10 @@ SUBROUTINE MD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WriteOutput)>0) OutData%WriteOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WriteOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WriteOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE MD_UnPackOutput @@ -5278,8 +5143,8 @@ SUBROUTINE MD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'MD_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -5294,6 +5159,8 @@ SUBROUTINE MD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(u1%PtFairleadDisplacement, u2%PtFairleadDisplacement, tin, u_out%PtFairleadDisplacement, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE MD_Input_ExtrapInterp1 @@ -5325,8 +5192,9 @@ SUBROUTINE MD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'MD_Input_ExtrapInterp2' @@ -5348,6 +5216,8 @@ SUBROUTINE MD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(u1%PtFairleadDisplacement, u2%PtFairleadDisplacement, u3%PtFairleadDisplacement, tin, u_out%PtFairleadDisplacement, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE MD_Input_ExtrapInterp2 @@ -5427,12 +5297,12 @@ SUBROUTINE MD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'MD_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -5445,15 +5315,15 @@ SUBROUTINE MD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(y1%PtFairleadLoad, y2%PtFairleadLoad, tin, y_out%PtFairleadLoad, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = -(y1%WriteOutput - y2%WriteOutput)/t(2) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO END IF ! check if allocated END SUBROUTINE MD_Output_ExtrapInterp1 @@ -5484,13 +5354,14 @@ SUBROUTINE MD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'MD_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -5509,16 +5380,16 @@ SUBROUTINE MD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(y1%PtFairleadLoad, y2%PtFairleadLoad, y3%PtFairleadLoad, tin, y_out%PtFairleadLoad, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = (t(3)**2*(y1%WriteOutput - y2%WriteOutput) + t(2)**2*(-y1%WriteOutput + y3%WriteOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WriteOutput + t(3)*y2%WriteOutput - t(2)*y3%WriteOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO END IF ! check if allocated END SUBROUTINE MD_Output_ExtrapInterp2 diff --git a/modules/nwtc-library/src/ModMesh.f90 b/modules/nwtc-library/src/ModMesh.f90 index e5af024392..00a8ee68fd 100644 --- a/modules/nwtc-library/src/ModMesh.f90 +++ b/modules/nwtc-library/src/ModMesh.f90 @@ -1543,7 +1543,7 @@ SUBROUTINE MeshPack ( Mesh, ReKiBuf, DbKiBuf, IntKiBuf , ErrStat, ErrMess, SizeO ELSE ! initialized, may or may not be committed Int_BufSz = 3 & ! number of logicals in MeshType (initialized, committed, RemapFlag) + FIELDMASK_SIZE & ! number of logicals in MeshType (fieldmask) - + 4 ! number of non-pointer integers (ios, nnodes, nextelem, nscalars) + + 5 ! number of non-pointer integers (ios, nnodes, nextelem, nscalars, refNode) !...... ! we'll store the element structure (and call MeshCommit on Unpack if necessary to get the remaining fields like det_jac) @@ -1638,6 +1638,7 @@ SUBROUTINE MeshPack ( Mesh, ReKiBuf, DbKiBuf, IntKiBuf , ErrStat, ErrMess, SizeO ! integers IntKiBuf(Int_Xferred) = Mesh%ios; Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = Mesh%nnodes; Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = Mesh%refnode; Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = Mesh%nextelem; Int_Xferred = Int_Xferred + 1 IntKiBuf(Int_Xferred) = Mesh%nscalars; Int_Xferred = Int_Xferred + 1 @@ -1746,7 +1747,7 @@ SUBROUTINE MeshUnpack( Mesh, ReKiBuf, DbKiBuf, IntKiBuf, ErrStat, ErrMess ) ! Local LOGICAL committed, RemapFlag, fieldmask(FIELDMASK_SIZE) - INTEGER nScalars, ios, nnodes, nextelem, nelemnodes, nelem + INTEGER nScalars, ios, nnodes, nextelem, nelemnodes, nelem, refnode INTEGER i,j INTEGER(IntKi) :: Re_Xferred ! number of reals transferred @@ -1780,6 +1781,7 @@ SUBROUTINE MeshUnpack( Mesh, ReKiBuf, DbKiBuf, IntKiBuf, ErrStat, ErrMess ) ! integers ios = IntKiBuf(Int_Xferred) ; Int_Xferred = Int_Xferred + 1 nnodes = IntKiBuf(Int_Xferred) ; Int_Xferred = Int_Xferred + 1 + refnode = IntKiBuf(Int_Xferred) ; Int_Xferred = Int_Xferred + 1 nextelem = IntKiBuf(Int_Xferred) ; Int_Xferred = Int_Xferred + 1 nscalars = IntKiBuf(Int_Xferred) ; Int_Xferred = Int_Xferred + 1 @@ -1799,6 +1801,7 @@ SUBROUTINE MeshUnpack( Mesh, ReKiBuf, DbKiBuf, IntKiBuf, ErrStat, ErrMess ) CALL SetErrStat(ErrStat2, ErrMess2, ErrStat, ErrMess, RoutineName) IF (ErrStat >= AbortErrLev) RETURN + Mesh%RefNode = refnode Mesh%RemapFlag = RemapFlag Mesh%nextelem = nextelem @@ -2013,7 +2016,7 @@ SUBROUTINE MeshCopy( SrcMesh, DestMesh, CtrlCode, ErrStat , ErrMess & IF ( CtrlCode .EQ. MESH_NEWCOPY .OR. CtrlCode .EQ. MESH_SIBLING .OR. CtrlCode .EQ. MESH_COUSIN ) THEN IF (CtrlCode .EQ. MESH_NEWCOPY) THEN - IOS_l = SrcMesh%IOS + IOS_l = SrcMesh%IOS Force_l = SrcMesh%FieldMask(MASKID_FORCE) Moment_l = SrcMesh%FieldMask(MASKID_MOMENT) Orientation_l = SrcMesh%FieldMask(MASKID_ORIENTATION) @@ -2195,6 +2198,7 @@ SUBROUTINE MeshCopy( SrcMesh, DestMesh, CtrlCode, ErrStat , ErrMess & DestMesh%Initialized = SrcMesh%Initialized DestMesh%Committed = SrcMesh%Committed + DestMesh%refNode = SrcMesh%refNode IF ( ALLOCATED(SrcMesh%Force ) .AND. ALLOCATED(DestMesh%Force ) ) DestMesh%Force = SrcMesh%Force IF ( ALLOCATED(SrcMesh%Moment ) .AND. ALLOCATED(DestMesh%Moment ) ) DestMesh%Moment = SrcMesh%Moment IF ( ALLOCATED(SrcMesh%Orientation ) .AND. ALLOCATED(DestMesh%Orientation ) ) DestMesh%Orientation = SrcMesh%Orientation @@ -2215,7 +2219,7 @@ END SUBROUTINE MeshCopy !! If an Orient argument is included, the node will also be assigned the specified orientation !! (orientation is assumed to be the identity matrix if omitted). Returns a non-zero value in !! ErrStat if Inode is outside the range 1..Nnodes. - SUBROUTINE MeshPositionNode( Mesh, Inode, Pos, ErrStat, ErrMess, Orient ) + SUBROUTINE MeshPositionNode( Mesh, Inode, Pos, ErrStat, ErrMess, Orient, Ref ) TYPE(MeshType), INTENT(INOUT) :: Mesh !< Mesh being spatio-located INTEGER(IntKi), INTENT(IN ) :: Inode !< Number of node being located @@ -2223,6 +2227,7 @@ SUBROUTINE MeshPositionNode( Mesh, Inode, Pos, ErrStat, ErrMess, Orient ) INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error code CHARACTER(*), INTENT( OUT) :: ErrMess !< Error message REAL(R8Ki), OPTIONAL, INTENT(IN ) :: Orient(3,3) !< Orientation (direction cosine matrix) of node; identity by default + LOGICAL, OPTIONAL, INTENT(IN ) :: Ref ErrStat = ErrID_None ErrMess = "" @@ -2276,6 +2281,10 @@ SUBROUTINE MeshPositionNode( Mesh, Inode, Pos, ErrStat, ErrMess, Orient ) Mesh%RefOrientation(:,3,Inode) = (/ 0._R8Ki, 0._R8Ki, 1._R8Ki /) END IF + IF (PRESENT(Ref)) THEN + Mesh%RefNode = Inode + END IF + RETURN END SUBROUTINE MeshPositionNode @@ -2913,9 +2922,9 @@ SUBROUTINE PackLoadMesh_Names(M, MeshName, Names, indx_first) do j=1,3 Names(indx_first) = trim(MeshName)//' '//Comp(j)//' moment, node '//trim(num2lstr(i))//', Nm'//UnitDesc indx_first = indx_first + 1 - end do + end do end do - end if + end if END SUBROUTINE PackLoadMesh_Names !............................................................................................................................... @@ -2944,9 +2953,9 @@ SUBROUTINE PackLoadMesh(M, Ary, indx_first) do j=1,3 Ary(indx_first) = M%Moment(j,i) indx_first = indx_first + 1 - end do + end do end do - end if + end if END SUBROUTINE PackLoadMesh !............................................................................................................................... @@ -2977,7 +2986,7 @@ SUBROUTINE PackLoadMesh_dY(M_p, M_m, dY, indx_first) indx_first = indx_last + 1 end do end if - + END SUBROUTINE PackLoadMesh_dY !............................................................................................................................... !> This subroutine returns the names of rows/columns of motion meshes in the Jacobian matrices. It assumes all fields marked @@ -3064,17 +3073,23 @@ END SUBROUTINE PackMotionMesh_Names !> This subroutine returns the operating point values of the mesh fields. It assumes all fields marked !! by FieldMask are allocated; Some fields may be allocated by the ModMesh module and not used in !! the linearization procedure, thus I am not using the check if they are allocated to determine if they should be included. - SUBROUTINE PackMotionMesh(M, Ary, indx_first, FieldMask) + SUBROUTINE PackMotionMesh(M, Ary, indx_first, FieldMask, UseLogMaps) TYPE(MeshType) , INTENT(IN ) :: M !< Motion mesh REAL(ReKi) , INTENT(INOUT) :: Ary(:) !< array to pack this mesh into INTEGER(IntKi) , INTENT(INOUT) :: indx_first !< index into Ary; gives location of next array position to fill LOGICAL, OPTIONAL , INTENT(IN ) :: FieldMask(FIELDMASK_SIZE) !< flags to determine if this field is part of the packing + LOGICAL, OPTIONAL , INTENT(IN ) :: UseLogMaps !< flag to determine if the orientation should be packed as a DCM or a log map ! local variables: INTEGER(IntKi) :: i, j, k LOGICAL :: Mask(FIELDMASK_SIZE) !< flags to determine if this field is part of the packing + LOGICAL :: OutputLogMap + REAL(R8Ki) :: logmap(3) !< array to pack logmaps into + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + if (present(FieldMask)) then Mask = FieldMask @@ -3093,14 +3108,30 @@ SUBROUTINE PackMotionMesh(M, Ary, indx_first, FieldMask) end if if (Mask(MASKID_ORIENTATION)) then - do i=1,M%NNodes - do j=1,3 - do k=1,3 ! note this gives us 9 values instead of 3 for this "operating point" - Ary(indx_first) = M%Orientation(j,k,i) + if (present(UseLogMaps)) then + OutputLogMap = UseLogMaps + else + OutputLogMap = .false. + end if + + if (OutputLogMap) then + do i=1,M%NNodes + call DCM_logMap(M%Orientation(:,:,i), logmap, ErrStat2, ErrMsg2) + do k=1,3 + Ary(indx_first) = logmap(k) indx_first = indx_first + 1 - end do - end do - end do + end do + end do + else + do i=1,M%NNodes + do j=1,3 + do k=1,3 ! note this gives us 9 values instead of 3 for this "operating point" + Ary(indx_first) = M%Orientation(j,k,i) + indx_first = indx_first + 1 + end do + end do + end do + end if end if if (Mask(MASKID_TRANSLATIONVEL)) then @@ -3388,7 +3419,7 @@ SUBROUTINE MeshExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrMsg ) if ( size(t) .ne. order+1) then ErrStat = ErrID_Fatal - ErrMsg = 'MeshExtrapInterp2: size(t) must equal 2.' + ErrMsg = 'MeshExtrapInterp2: size(t) must equal 3.' RETURN end if diff --git a/modules/nwtc-library/src/ModMesh_Mapping.f90 b/modules/nwtc-library/src/ModMesh_Mapping.f90 index c2a13e4ee0..bdde696bf5 100644 --- a/modules/nwtc-library/src/ModMesh_Mapping.f90 +++ b/modules/nwtc-library/src/ModMesh_Mapping.f90 @@ -59,13 +59,13 @@ MODULE ModMesh_Mapping REAL(R8Ki), ALLOCATABLE :: M_uS(:,:) !< block matrix of moment that is multiplied by Source u (translationDisp) [-] REAL(R8Ki), ALLOCATABLE :: M_uD(:,:) !< block matrix of moment that is multiplied by Destination u (translationDisp) [-] REAL(R8Ki), ALLOCATABLE :: M_f(:,:) !< block matrix of moment that is multiplied by force [-] - END TYPE + END TYPE MeshMapLinearizationType !> data structures to determine full mapping between fields on different meshes TYPE, PUBLIC :: MeshMapType - TYPE(MapType), ALLOCATABLE :: MapLoads(:) !< mapping for load fields - TYPE(MapType), ALLOCATABLE :: MapMotions(:) !< mapping for motion fields + TYPE(MapType), ALLOCATABLE :: MapLoads(:) !< mapping data structure for loads on the mesh + TYPE(MapType), ALLOCATABLE :: MapMotions(:) !< mapping data structure for motions and/or scalars on the mesh [-] TYPE(MapType), ALLOCATABLE :: MapSrcToAugmt(:) !< for source line2 loads, we map between source and an augmented source mesh, then between augmented source and destination TYPE(MeshType) :: Augmented_Ln2_Src !< the augmented source mesh needed for some mapping types TYPE(MeshType) :: Lumped_Points_Src !< a lumped mesh needed for some mapping types, stored here for efficiency @@ -73,7 +73,7 @@ MODULE ModMesh_Mapping TYPE(MeshType) :: Lumped_Points_Dest #endif INTEGER, ALLOCATABLE :: LoadLn2_A_Mat_Piv(:) !< The pivot values for the factorization of LoadLn2_A_Mat - REAL(R8Ki), ALLOCATABLE :: DisplacedPosition(:,:,:) !< couple_arm +Scr%Disp - Dest%Disp for each mapped node (stored here for efficiency.) + REAL(R8Ki), ALLOCATABLE :: DisplacedPosition(:,:,:) !< couple_arm +Scr%Disp - Dest%Disp for each mapped node (stored here for efficiency) REAL(R8Ki), ALLOCATABLE :: LoadLn2_A_Mat(:,:) !< The n-by-n (n=3xNNodes) matrix that makes up the diagonal of the [A 0; B A] matrix in the point-to-line load mapping REAL(R8Ki), ALLOCATABLE :: LoadLn2_F(:,:) !< The 3-components of the forces for each node of an element in the point-to-line load mapping (for each element) REAL(R8Ki), ALLOCATABLE :: LoadLn2_M(:,:) !< The 3-components of the moments for each node of an element in the point-to-line load mapping (for each element) @@ -1227,6 +1227,7 @@ SUBROUTINE Transfer_Motions_Line2_to_Point( Src, Dest, MeshMap, ErrStat, ErrMsg ! local variables INTEGER(IntKi) :: i , j ! counter over the nodes INTEGER(IntKi) :: k ! counter components + INTEGER(IntKi) :: nScalars ! number of scalars transferred INTEGER(IntKi) :: n, n1, n2 ! temporary space for node numbers REAL(R8Ki) :: FieldValueN1(3) ! Temporary variable to store field values on element nodes REAL(R8Ki) :: FieldValueN2(3) ! Temporary variable to store field values on element nodes @@ -1495,14 +1496,21 @@ SUBROUTINE Transfer_Motions_Line2_to_Point( Src, Dest, MeshMap, ErrStat, ErrMsg !! \phi_i\f$ if (Src%FieldMask(MASKID_SCALAR) .AND. Dest%FieldMask(MASKID_SCALAR) ) then + nScalars = min(Dest%nScalars, Src%nScalars) + + if (Dest%nScalars > nScalars) then + call SetErrStat(ErrID_Severe, "Not all scalars could be computed from source mesh (insufficient data).", ErrStat, ErrMsg, 'Transfer_Motions_Line2_to_Point') + Dest%Scalars(nScalars+1:,:) = 0.0_ReKi + end if + do i=1, Dest%Nnodes !if ( MeshMap%MapMotions(i)%OtherMesh_Element < 1 ) CYCLE n1 = Src%ElemTable(ELEMENT_LINE2)%Elements(MeshMap%MapMotions(i)%OtherMesh_Element)%ElemNodes(1) n2 = Src%ElemTable(ELEMENT_LINE2)%Elements(MeshMap%MapMotions(i)%OtherMesh_Element)%ElemNodes(2) - Dest%Scalars(:,i) = MeshMap%MapMotions(i)%shape_fn(1)*Src%Scalars(:,n1) & - + MeshMap%MapMotions(i)%shape_fn(2)*Src%Scalars(:,n2) + Dest%Scalars(1:nScalars,i) = MeshMap%MapMotions(i)%shape_fn(1)*Src%Scalars(1:nScalars,n1) & + + MeshMap%MapMotions(i)%shape_fn(2)*Src%Scalars(1:nScalars,n2) end do end if @@ -1941,7 +1949,7 @@ SUBROUTINE CreateMapping_ProjectToLine2(Mesh1, Mesh2, NodeMap, Mesh1_TYPE, ErrSt ! if failed to find an element that the Point projected into, throw an error if (.not. found) then - if ( closest_elem_distance < 5.0e-3 ) then ! if it is within 5mm of the end of an element, we'll accept it + if ( closest_elem_distance <= 7.5e-3 ) then ! if it is within 7.5mm of the end of an element, we'll accept it NodeMap(i)%OtherMesh_Element = closest_elem NodeMap(i)%shape_fn(1) = 1.0_ReKi - closest_elem_position NodeMap(i)%shape_fn(2) = closest_elem_position @@ -1949,7 +1957,8 @@ SUBROUTINE CreateMapping_ProjectToLine2(Mesh1, Mesh2, NodeMap, Mesh1_TYPE, ErrSt end if if (NodeMap(i)%OtherMesh_Element .lt. 1 ) then - CALL SetErrStat( ErrID_Fatal, 'Node '//trim(num2Lstr(i))//' does not project onto any line2 element.', ErrStat, ErrMsg, RoutineName) + CALL SetErrStat( ErrID_Fatal, 'Node '//trim(num2Lstr(i))//' does not project onto any line2 element.' & + //' Closest distance is '//trim(num2lstr(closest_elem_distance))//' m.', ErrStat, ErrMsg, RoutineName) #ifdef DEBUG_MESHMAPPING ! output some mesh information for debugging @@ -2625,6 +2634,7 @@ SUBROUTINE Transfer_Motions_Point_to_Point( Src, Dest, MeshMap, ErrStat, ErrMsg CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None ! local variables + INTEGER(IntKi) :: nScalars INTEGER(IntKi) :: i, j ! counter over the nodes REAL(R8Ki) :: RotationMatrix(3,3) REAL(ReKi) :: TmpVec(3) @@ -2773,10 +2783,17 @@ SUBROUTINE Transfer_Motions_Point_to_Point( Src, Dest, MeshMap, ErrStat, ErrMsg !> Scalars: \f$S^D = S^S\f$ if (Src%FieldMask(MASKID_SCALAR) .AND. Dest%FieldMask(MASKID_SCALAR) ) then + nScalars = min(Dest%nScalars, Src%nScalars) + + if (Dest%nScalars > nScalars) then + call SetErrStat(ErrID_Severe, "Not all scalars could be computed from source mesh (insufficient data).", ErrStat, ErrMsg, 'Transfer_Motions_Point_to_Point') + Dest%Scalars(nScalars+1:,:) = 0.0_ReKi + end if + do i=1, Dest%Nnodes !if ( MeshMap%MapMotions(i)%OtherMesh_Element < 1 ) CYCLE - Dest%Scalars(:,i) = Src%Scalars(:,MeshMap%MapMotions(i)%OtherMesh_Element) + Dest%Scalars(1:nScalars,i) = Src%Scalars(1:nScalars,MeshMap%MapMotions(i)%OtherMesh_Element) end do end if @@ -5540,7 +5557,7 @@ SUBROUTINE WriteMappingTransferToFile(Mesh1_I,Mesh1_O,Mesh2_I,Mesh2_O,Map_Mod1_M INTEGER(IntKi) :: i INTEGER(IntKi) :: un_out INTEGER(IntKi) :: ErrStat ! Error status of the operation - CHARACTER(1024) :: ErrMsg ! Error message if ErrStat /= ErrID_None + CHARACTER(ErrMsgLen) :: ErrMsg ! Error message if ErrStat /= ErrID_None CHARACTER(256) :: PrintWarnF, PrintWarnM, TmpValues #ifdef MESH_DEBUG @@ -5863,14 +5880,18 @@ SUBROUTINE NWTC_Library_PackMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%OtherMesh_Element - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%distance - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%couple_arm))-1 ) = PACK(InData%couple_arm,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%couple_arm) - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%shape_fn))-1 ) = PACK(InData%shape_fn,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%shape_fn) + IntKiBuf(Int_Xferred) = InData%OtherMesh_Element + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%distance + Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(InData%couple_arm,1), UBOUND(InData%couple_arm,1) + DbKiBuf(Db_Xferred) = InData%couple_arm(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%shape_fn,1), UBOUND(InData%shape_fn,1) + DbKiBuf(Db_Xferred) = InData%shape_fn(i1) + Db_Xferred = Db_Xferred + 1 + END DO END SUBROUTINE NWTC_Library_PackMapType SUBROUTINE NWTC_Library_UnPackMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -5886,12 +5907,6 @@ SUBROUTINE NWTC_Library_UnPackMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (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 @@ -5908,32 +5923,22 @@ SUBROUTINE NWTC_Library_UnPackMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%OtherMesh_Element = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%distance = REAL( DbKiBuf( Db_Xferred ), R8Ki) - Db_Xferred = Db_Xferred + 1 + OutData%OtherMesh_Element = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%distance = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 i1_l = LBOUND(OutData%couple_arm,1) i1_u = UBOUND(OutData%couple_arm,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%couple_arm = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%couple_arm))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%couple_arm) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%couple_arm,1), UBOUND(OutData%couple_arm,1) + OutData%couple_arm(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%shape_fn,1) i1_u = UBOUND(OutData%shape_fn,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%shape_fn = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%shape_fn))-1 ), mask1, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%shape_fn) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%shape_fn,1), UBOUND(OutData%shape_fn,1) + OutData%shape_fn(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO END SUBROUTINE NWTC_Library_UnPackMapType SUBROUTINE NWTC_Library_CopyMeshMapLinearizationType( SrcMeshMapLinearizationTypeData, DstMeshMapLinearizationTypeData, CtrlCode, ErrStat, ErrMsg ) @@ -6282,8 +6287,12 @@ SUBROUTINE NWTC_Library_PackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiBuf IntKiBuf( Int_Xferred + 1) = UBOUND(InData%mi,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%mi)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%mi))-1 ) = PACK(InData%mi,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%mi) + DO i2 = LBOUND(InData%mi,2), UBOUND(InData%mi,2) + DO i1 = LBOUND(InData%mi,1), UBOUND(InData%mi,1) + DbKiBuf(Db_Xferred) = InData%mi(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%fx_p) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6298,8 +6307,12 @@ SUBROUTINE NWTC_Library_PackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiBuf IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fx_p,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%fx_p)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%fx_p))-1 ) = PACK(InData%fx_p,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%fx_p) + DO i2 = LBOUND(InData%fx_p,2), UBOUND(InData%fx_p,2) + DO i1 = LBOUND(InData%fx_p,1), UBOUND(InData%fx_p,1) + DbKiBuf(Db_Xferred) = InData%fx_p(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%tv_uD) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6314,8 +6327,12 @@ SUBROUTINE NWTC_Library_PackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiBuf IntKiBuf( Int_Xferred + 1) = UBOUND(InData%tv_uD,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%tv_uD)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%tv_uD))-1 ) = PACK(InData%tv_uD,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%tv_uD) + DO i2 = LBOUND(InData%tv_uD,2), UBOUND(InData%tv_uD,2) + DO i1 = LBOUND(InData%tv_uD,1), UBOUND(InData%tv_uD,1) + DbKiBuf(Db_Xferred) = InData%tv_uD(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%tv_uS) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6330,8 +6347,12 @@ SUBROUTINE NWTC_Library_PackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiBuf IntKiBuf( Int_Xferred + 1) = UBOUND(InData%tv_uS,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%tv_uS)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%tv_uS))-1 ) = PACK(InData%tv_uS,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%tv_uS) + DO i2 = LBOUND(InData%tv_uS,2), UBOUND(InData%tv_uS,2) + DO i1 = LBOUND(InData%tv_uS,1), UBOUND(InData%tv_uS,1) + DbKiBuf(Db_Xferred) = InData%tv_uS(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%ta_uD) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6346,8 +6367,12 @@ SUBROUTINE NWTC_Library_PackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiBuf IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ta_uD,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ta_uD)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%ta_uD))-1 ) = PACK(InData%ta_uD,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%ta_uD) + DO i2 = LBOUND(InData%ta_uD,2), UBOUND(InData%ta_uD,2) + DO i1 = LBOUND(InData%ta_uD,1), UBOUND(InData%ta_uD,1) + DbKiBuf(Db_Xferred) = InData%ta_uD(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%ta_uS) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6362,8 +6387,12 @@ SUBROUTINE NWTC_Library_PackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiBuf IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ta_uS,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ta_uS)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%ta_uS))-1 ) = PACK(InData%ta_uS,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%ta_uS) + DO i2 = LBOUND(InData%ta_uS,2), UBOUND(InData%ta_uS,2) + DO i1 = LBOUND(InData%ta_uS,1), UBOUND(InData%ta_uS,1) + DbKiBuf(Db_Xferred) = InData%ta_uS(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%ta_rv) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6378,8 +6407,12 @@ SUBROUTINE NWTC_Library_PackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiBuf IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ta_rv,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ta_rv)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%ta_rv))-1 ) = PACK(InData%ta_rv,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%ta_rv) + DO i2 = LBOUND(InData%ta_rv,2), UBOUND(InData%ta_rv,2) + DO i1 = LBOUND(InData%ta_rv,1), UBOUND(InData%ta_rv,1) + DbKiBuf(Db_Xferred) = InData%ta_rv(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%li) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6394,8 +6427,12 @@ SUBROUTINE NWTC_Library_PackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiBuf IntKiBuf( Int_Xferred + 1) = UBOUND(InData%li,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%li)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%li))-1 ) = PACK(InData%li,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%li) + DO i2 = LBOUND(InData%li,2), UBOUND(InData%li,2) + DO i1 = LBOUND(InData%li,1), UBOUND(InData%li,1) + DbKiBuf(Db_Xferred) = InData%li(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%M_uS) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6410,8 +6447,12 @@ SUBROUTINE NWTC_Library_PackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiBuf IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M_uS,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%M_uS)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%M_uS))-1 ) = PACK(InData%M_uS,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%M_uS) + DO i2 = LBOUND(InData%M_uS,2), UBOUND(InData%M_uS,2) + DO i1 = LBOUND(InData%M_uS,1), UBOUND(InData%M_uS,1) + DbKiBuf(Db_Xferred) = InData%M_uS(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%M_uD) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6426,8 +6467,12 @@ SUBROUTINE NWTC_Library_PackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiBuf IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M_uD,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%M_uD)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%M_uD))-1 ) = PACK(InData%M_uD,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%M_uD) + DO i2 = LBOUND(InData%M_uD,2), UBOUND(InData%M_uD,2) + DO i1 = LBOUND(InData%M_uD,1), UBOUND(InData%M_uD,1) + DbKiBuf(Db_Xferred) = InData%M_uD(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%M_f) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6442,8 +6487,12 @@ SUBROUTINE NWTC_Library_PackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiBuf IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M_f,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%M_f)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%M_f))-1 ) = PACK(InData%M_f,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%M_f) + DO i2 = LBOUND(InData%M_f,2), UBOUND(InData%M_f,2) + DO i1 = LBOUND(InData%M_f,1), UBOUND(InData%M_f,1) + DbKiBuf(Db_Xferred) = InData%M_f(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF END SUBROUTINE NWTC_Library_PackMeshMapLinearizationType @@ -6460,12 +6509,6 @@ SUBROUTINE NWTC_Library_UnPackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiB INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -6497,15 +6540,12 @@ SUBROUTINE NWTC_Library_UnPackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiB CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%mi.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%mi)>0) OutData%mi = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%mi))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%mi) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%mi,2), UBOUND(OutData%mi,2) + DO i1 = LBOUND(OutData%mi,1), UBOUND(OutData%mi,1) + OutData%mi(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fx_p not allocated Int_Xferred = Int_Xferred + 1 @@ -6523,15 +6563,12 @@ SUBROUTINE NWTC_Library_UnPackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiB CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%fx_p.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%fx_p)>0) OutData%fx_p = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%fx_p))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%fx_p) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%fx_p,2), UBOUND(OutData%fx_p,2) + DO i1 = LBOUND(OutData%fx_p,1), UBOUND(OutData%fx_p,1) + OutData%fx_p(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! tv_uD not allocated Int_Xferred = Int_Xferred + 1 @@ -6549,15 +6586,12 @@ SUBROUTINE NWTC_Library_UnPackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiB CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%tv_uD.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%tv_uD)>0) OutData%tv_uD = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%tv_uD))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%tv_uD) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%tv_uD,2), UBOUND(OutData%tv_uD,2) + DO i1 = LBOUND(OutData%tv_uD,1), UBOUND(OutData%tv_uD,1) + OutData%tv_uD(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! tv_uS not allocated Int_Xferred = Int_Xferred + 1 @@ -6575,15 +6609,12 @@ SUBROUTINE NWTC_Library_UnPackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiB CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%tv_uS.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%tv_uS)>0) OutData%tv_uS = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%tv_uS))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%tv_uS) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%tv_uS,2), UBOUND(OutData%tv_uS,2) + DO i1 = LBOUND(OutData%tv_uS,1), UBOUND(OutData%tv_uS,1) + OutData%tv_uS(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ta_uD not allocated Int_Xferred = Int_Xferred + 1 @@ -6601,15 +6632,12 @@ SUBROUTINE NWTC_Library_UnPackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiB CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ta_uD.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%ta_uD)>0) OutData%ta_uD = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%ta_uD))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%ta_uD) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%ta_uD,2), UBOUND(OutData%ta_uD,2) + DO i1 = LBOUND(OutData%ta_uD,1), UBOUND(OutData%ta_uD,1) + OutData%ta_uD(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ta_uS not allocated Int_Xferred = Int_Xferred + 1 @@ -6627,15 +6655,12 @@ SUBROUTINE NWTC_Library_UnPackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiB CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ta_uS.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%ta_uS)>0) OutData%ta_uS = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%ta_uS))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%ta_uS) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%ta_uS,2), UBOUND(OutData%ta_uS,2) + DO i1 = LBOUND(OutData%ta_uS,1), UBOUND(OutData%ta_uS,1) + OutData%ta_uS(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ta_rv not allocated Int_Xferred = Int_Xferred + 1 @@ -6653,15 +6678,12 @@ SUBROUTINE NWTC_Library_UnPackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiB CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ta_rv.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%ta_rv)>0) OutData%ta_rv = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%ta_rv))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%ta_rv) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%ta_rv,2), UBOUND(OutData%ta_rv,2) + DO i1 = LBOUND(OutData%ta_rv,1), UBOUND(OutData%ta_rv,1) + OutData%ta_rv(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! li not allocated Int_Xferred = Int_Xferred + 1 @@ -6679,15 +6701,12 @@ SUBROUTINE NWTC_Library_UnPackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiB CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%li.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%li)>0) OutData%li = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%li))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%li) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%li,2), UBOUND(OutData%li,2) + DO i1 = LBOUND(OutData%li,1), UBOUND(OutData%li,1) + OutData%li(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! M_uS not allocated Int_Xferred = Int_Xferred + 1 @@ -6705,15 +6724,12 @@ SUBROUTINE NWTC_Library_UnPackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiB CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%M_uS.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%M_uS)>0) OutData%M_uS = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%M_uS))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%M_uS) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%M_uS,2), UBOUND(OutData%M_uS,2) + DO i1 = LBOUND(OutData%M_uS,1), UBOUND(OutData%M_uS,1) + OutData%M_uS(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! M_uD not allocated Int_Xferred = Int_Xferred + 1 @@ -6731,15 +6747,12 @@ SUBROUTINE NWTC_Library_UnPackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiB CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%M_uD.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%M_uD)>0) OutData%M_uD = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%M_uD))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%M_uD) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%M_uD,2), UBOUND(OutData%M_uD,2) + DO i1 = LBOUND(OutData%M_uD,1), UBOUND(OutData%M_uD,1) + OutData%M_uD(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! M_f not allocated Int_Xferred = Int_Xferred + 1 @@ -6757,15 +6770,12 @@ SUBROUTINE NWTC_Library_UnPackMeshMapLinearizationType( ReKiBuf, DbKiBuf, IntKiB CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%M_f.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%M_f)>0) OutData%M_f = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%M_f))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%M_f) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%M_f,2), UBOUND(OutData%M_f,2) + DO i1 = LBOUND(OutData%M_f,1), UBOUND(OutData%M_f,1) + OutData%M_f(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF END SUBROUTINE NWTC_Library_UnPackMeshMapLinearizationType @@ -6868,20 +6878,6 @@ SUBROUTINE NWTC_Library_CopyMeshMapType( SrcMeshMapTypeData, DstMeshMapTypeData, END IF DstMeshMapTypeData%DisplacedPosition = SrcMeshMapTypeData%DisplacedPosition ENDIF -IF (ALLOCATED(SrcMeshMapTypeData%LoadLn2_F)) THEN - i1_l = LBOUND(SrcMeshMapTypeData%LoadLn2_F,1) - i1_u = UBOUND(SrcMeshMapTypeData%LoadLn2_F,1) - i2_l = LBOUND(SrcMeshMapTypeData%LoadLn2_F,2) - i2_u = UBOUND(SrcMeshMapTypeData%LoadLn2_F,2) - IF (.NOT. ALLOCATED(DstMeshMapTypeData%LoadLn2_F)) THEN - ALLOCATE(DstMeshMapTypeData%LoadLn2_F(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapTypeData%LoadLn2_F.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstMeshMapTypeData%LoadLn2_F = SrcMeshMapTypeData%LoadLn2_F -ENDIF IF (ALLOCATED(SrcMeshMapTypeData%LoadLn2_A_Mat)) THEN i1_l = LBOUND(SrcMeshMapTypeData%LoadLn2_A_Mat,1) i1_u = UBOUND(SrcMeshMapTypeData%LoadLn2_A_Mat,1) @@ -6896,6 +6892,20 @@ SUBROUTINE NWTC_Library_CopyMeshMapType( SrcMeshMapTypeData, DstMeshMapTypeData, END IF DstMeshMapTypeData%LoadLn2_A_Mat = SrcMeshMapTypeData%LoadLn2_A_Mat ENDIF +IF (ALLOCATED(SrcMeshMapTypeData%LoadLn2_F)) THEN + i1_l = LBOUND(SrcMeshMapTypeData%LoadLn2_F,1) + i1_u = UBOUND(SrcMeshMapTypeData%LoadLn2_F,1) + i2_l = LBOUND(SrcMeshMapTypeData%LoadLn2_F,2) + i2_u = UBOUND(SrcMeshMapTypeData%LoadLn2_F,2) + IF (.NOT. ALLOCATED(DstMeshMapTypeData%LoadLn2_F)) THEN + ALLOCATE(DstMeshMapTypeData%LoadLn2_F(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMeshMapTypeData%LoadLn2_F.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMeshMapTypeData%LoadLn2_F = SrcMeshMapTypeData%LoadLn2_F +ENDIF IF (ALLOCATED(SrcMeshMapTypeData%LoadLn2_M)) THEN i1_l = LBOUND(SrcMeshMapTypeData%LoadLn2_M,1) i1_u = UBOUND(SrcMeshMapTypeData%LoadLn2_M,1) @@ -6950,12 +6960,12 @@ SUBROUTINE NWTC_Library_DestroyMeshMapType( MeshMapTypeData, ErrStat, ErrMsg ) IF (ALLOCATED(MeshMapTypeData%DisplacedPosition)) THEN DEALLOCATE(MeshMapTypeData%DisplacedPosition) ENDIF -IF (ALLOCATED(MeshMapTypeData%LoadLn2_F)) THEN - DEALLOCATE(MeshMapTypeData%LoadLn2_F) -ENDIF IF (ALLOCATED(MeshMapTypeData%LoadLn2_A_Mat)) THEN DEALLOCATE(MeshMapTypeData%LoadLn2_A_Mat) ENDIF +IF (ALLOCATED(MeshMapTypeData%LoadLn2_F)) THEN + DEALLOCATE(MeshMapTypeData%LoadLn2_F) +ENDIF IF (ALLOCATED(MeshMapTypeData%LoadLn2_M)) THEN DEALLOCATE(MeshMapTypeData%LoadLn2_M) ENDIF @@ -7111,16 +7121,16 @@ SUBROUTINE NWTC_Library_PackMeshMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Err Int_BufSz = Int_BufSz + 2*3 ! DisplacedPosition upper/lower bounds for each dimension Db_BufSz = Db_BufSz + SIZE(InData%DisplacedPosition) ! DisplacedPosition END IF - Int_BufSz = Int_BufSz + 1 ! LoadLn2_F allocated yes/no - IF ( ALLOCATED(InData%LoadLn2_F) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! LoadLn2_F upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%LoadLn2_F) ! LoadLn2_F - END IF Int_BufSz = Int_BufSz + 1 ! LoadLn2_A_Mat allocated yes/no IF ( ALLOCATED(InData%LoadLn2_A_Mat) ) THEN Int_BufSz = Int_BufSz + 2*2 ! LoadLn2_A_Mat upper/lower bounds for each dimension Db_BufSz = Db_BufSz + SIZE(InData%LoadLn2_A_Mat) ! LoadLn2_A_Mat END IF + Int_BufSz = Int_BufSz + 1 ! LoadLn2_F allocated yes/no + IF ( ALLOCATED(InData%LoadLn2_F) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! LoadLn2_F upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%LoadLn2_F) ! LoadLn2_F + END IF Int_BufSz = Int_BufSz + 1 ! LoadLn2_M allocated yes/no IF ( ALLOCATED(InData%LoadLn2_M) ) THEN Int_BufSz = Int_BufSz + 2*2 ! LoadLn2_M upper/lower bounds for each dimension @@ -7359,8 +7369,10 @@ SUBROUTINE NWTC_Library_PackMeshMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LoadLn2_A_Mat_Piv,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LoadLn2_A_Mat_Piv)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%LoadLn2_A_Mat_Piv))-1 ) = PACK(InData%LoadLn2_A_Mat_Piv,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%LoadLn2_A_Mat_Piv) + DO i1 = LBOUND(InData%LoadLn2_A_Mat_Piv,1), UBOUND(InData%LoadLn2_A_Mat_Piv,1) + IntKiBuf(Int_Xferred) = InData%LoadLn2_A_Mat_Piv(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%DisplacedPosition) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7378,40 +7390,54 @@ SUBROUTINE NWTC_Library_PackMeshMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DisplacedPosition,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%DisplacedPosition)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%DisplacedPosition))-1 ) = PACK(InData%DisplacedPosition,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%DisplacedPosition) + DO i3 = LBOUND(InData%DisplacedPosition,3), UBOUND(InData%DisplacedPosition,3) + DO i2 = LBOUND(InData%DisplacedPosition,2), UBOUND(InData%DisplacedPosition,2) + DO i1 = LBOUND(InData%DisplacedPosition,1), UBOUND(InData%DisplacedPosition,1) + DbKiBuf(Db_Xferred) = InData%DisplacedPosition(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF - IF ( .NOT. ALLOCATED(InData%LoadLn2_F) ) THEN + IF ( .NOT. ALLOCATED(InData%LoadLn2_A_Mat) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LoadLn2_F,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LoadLn2_F,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%LoadLn2_A_Mat,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LoadLn2_A_Mat,1) Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LoadLn2_F,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LoadLn2_F,2) + IntKiBuf( Int_Xferred ) = LBOUND(InData%LoadLn2_A_Mat,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LoadLn2_A_Mat,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LoadLn2_F)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%LoadLn2_F))-1 ) = PACK(InData%LoadLn2_F,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%LoadLn2_F) + DO i2 = LBOUND(InData%LoadLn2_A_Mat,2), UBOUND(InData%LoadLn2_A_Mat,2) + DO i1 = LBOUND(InData%LoadLn2_A_Mat,1), UBOUND(InData%LoadLn2_A_Mat,1) + DbKiBuf(Db_Xferred) = InData%LoadLn2_A_Mat(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF - IF ( .NOT. ALLOCATED(InData%LoadLn2_A_Mat) ) THEN + IF ( .NOT. ALLOCATED(InData%LoadLn2_F) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LoadLn2_A_Mat,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LoadLn2_A_Mat,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%LoadLn2_F,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LoadLn2_F,1) Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LoadLn2_A_Mat,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LoadLn2_A_Mat,2) + IntKiBuf( Int_Xferred ) = LBOUND(InData%LoadLn2_F,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LoadLn2_F,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LoadLn2_A_Mat)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%LoadLn2_A_Mat))-1 ) = PACK(InData%LoadLn2_A_Mat,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%LoadLn2_A_Mat) + DO i2 = LBOUND(InData%LoadLn2_F,2), UBOUND(InData%LoadLn2_F,2) + DO i1 = LBOUND(InData%LoadLn2_F,1), UBOUND(InData%LoadLn2_F,1) + DbKiBuf(Db_Xferred) = InData%LoadLn2_F(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%LoadLn2_M) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7426,8 +7452,12 @@ SUBROUTINE NWTC_Library_PackMeshMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LoadLn2_M,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%LoadLn2_M)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%LoadLn2_M))-1 ) = PACK(InData%LoadLn2_M,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%LoadLn2_M) + DO i2 = LBOUND(InData%LoadLn2_M,2), UBOUND(InData%LoadLn2_M,2) + DO i1 = LBOUND(InData%LoadLn2_M,1), UBOUND(InData%LoadLn2_M,1) + DbKiBuf(Db_Xferred) = InData%LoadLn2_M(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF CALL NWTC_Library_Packmeshmaplinearizationtype( Re_Buf, Db_Buf, Int_Buf, InData%dM, ErrStat2, ErrMsg2, OnlySize ) ! dM CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -7472,12 +7502,6 @@ SUBROUTINE NWTC_Library_UnPackMeshMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (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 @@ -7755,15 +7779,10 @@ SUBROUTINE NWTC_Library_UnPackMeshMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LoadLn2_A_Mat_Piv.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LoadLn2_A_Mat_Piv)>0) OutData%LoadLn2_A_Mat_Piv = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%LoadLn2_A_Mat_Piv))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%LoadLn2_A_Mat_Piv) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%LoadLn2_A_Mat_Piv,1), UBOUND(OutData%LoadLn2_A_Mat_Piv,1) + OutData%LoadLn2_A_Mat_Piv(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DisplacedPosition not allocated Int_Xferred = Int_Xferred + 1 @@ -7784,17 +7803,16 @@ SUBROUTINE NWTC_Library_UnPackMeshMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DisplacedPosition.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%DisplacedPosition)>0) OutData%DisplacedPosition = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%DisplacedPosition))-1 ), mask3, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%DisplacedPosition) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%DisplacedPosition,3), UBOUND(OutData%DisplacedPosition,3) + DO i2 = LBOUND(OutData%DisplacedPosition,2), UBOUND(OutData%DisplacedPosition,2) + DO i1 = LBOUND(OutData%DisplacedPosition,1), UBOUND(OutData%DisplacedPosition,1) + OutData%DisplacedPosition(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LoadLn2_F not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LoadLn2_A_Mat not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 @@ -7804,23 +7822,20 @@ SUBROUTINE NWTC_Library_UnPackMeshMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, i2_l = IntKiBuf( Int_Xferred ) i2_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LoadLn2_F)) DEALLOCATE(OutData%LoadLn2_F) - ALLOCATE(OutData%LoadLn2_F(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LoadLn2_F.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%LoadLn2_A_Mat)) DEALLOCATE(OutData%LoadLn2_A_Mat) + ALLOCATE(OutData%LoadLn2_A_Mat(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LoadLn2_A_Mat.', ErrStat, ErrMsg,RoutineName) RETURN END IF - mask2 = .TRUE. - IF (SIZE(OutData%LoadLn2_F)>0) OutData%LoadLn2_F = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%LoadLn2_F))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%LoadLn2_F) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%LoadLn2_A_Mat,2), UBOUND(OutData%LoadLn2_A_Mat,2) + DO i1 = LBOUND(OutData%LoadLn2_A_Mat,1), UBOUND(OutData%LoadLn2_A_Mat,1) + OutData%LoadLn2_A_Mat(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LoadLn2_A_Mat not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LoadLn2_F not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 @@ -7830,21 +7845,18 @@ SUBROUTINE NWTC_Library_UnPackMeshMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, i2_l = IntKiBuf( Int_Xferred ) i2_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LoadLn2_A_Mat)) DEALLOCATE(OutData%LoadLn2_A_Mat) - ALLOCATE(OutData%LoadLn2_A_Mat(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LoadLn2_A_Mat.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%LoadLn2_F)) DEALLOCATE(OutData%LoadLn2_F) + ALLOCATE(OutData%LoadLn2_F(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LoadLn2_F.', ErrStat, ErrMsg,RoutineName) RETURN END IF - mask2 = .TRUE. - IF (SIZE(OutData%LoadLn2_A_Mat)>0) OutData%LoadLn2_A_Mat = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%LoadLn2_A_Mat))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%LoadLn2_A_Mat) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%LoadLn2_F,2), UBOUND(OutData%LoadLn2_F,2) + DO i1 = LBOUND(OutData%LoadLn2_F,1), UBOUND(OutData%LoadLn2_F,1) + OutData%LoadLn2_F(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LoadLn2_M not allocated Int_Xferred = Int_Xferred + 1 @@ -7862,15 +7874,12 @@ SUBROUTINE NWTC_Library_UnPackMeshMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LoadLn2_M.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%LoadLn2_M)>0) OutData%LoadLn2_M = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%LoadLn2_M))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%LoadLn2_M) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%LoadLn2_M,2), UBOUND(OutData%LoadLn2_M,2) + DO i1 = LBOUND(OutData%LoadLn2_M,1), UBOUND(OutData%LoadLn2_M,1) + OutData%LoadLn2_M(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 diff --git a/modules/nwtc-library/src/ModMesh_Types.f90 b/modules/nwtc-library/src/ModMesh_Types.f90 index f4c82f3977..c3b1d71638 100644 --- a/modules/nwtc-library/src/ModMesh_Types.f90 +++ b/modules/nwtc-library/src/ModMesh_Types.f90 @@ -101,6 +101,7 @@ MODULE ModMesh_Types LOGICAL :: fieldmask(FIELDMASK_SIZE) = .FALSE. !< Dimension as number of allocatable fields, below LOGICAL,POINTER :: RemapFlag => NULL() !< false=no action/ignore; true=remap required INTEGER :: ios !< Mesh type: input (1), output(2), or state(3) + INTEGER :: refNode = 0 !< optional reference node (informational only) INTEGER :: Nnodes = 0 !< Number of nodes (vertices) in mesh ! Mesh elements diff --git a/modules/nwtc-library/src/NWTC_Base.f90 b/modules/nwtc-library/src/NWTC_Base.f90 index f59e9b97ae..bd3ff35b4f 100644 --- a/modules/nwtc-library/src/NWTC_Base.f90 +++ b/modules/nwtc-library/src/NWTC_Base.f90 @@ -35,8 +35,8 @@ MODULE NWTC_Base INTEGER, PARAMETER :: BITS_IN_ADDR = C_INTPTR_T*8 !< The number of bits in an address (32-bit or 64-bit). INTEGER, PARAMETER :: ErrMsgLen = 1024 !< The maximum number of characters in an error message in the FAST framework - INTEGER(IntKi), PARAMETER :: ChanLen = 10 !< The allowable length of channel names (i.e., width of output columns) in the FAST framework - INTEGER(IntKi), PARAMETER :: ChanLenFF = 14 !< The allowable length of channel names (i.e., width of output columns) in the FAST.Farm software + INTEGER(IntKi), PARAMETER :: ChanLen = 20 !< The maximum allowable length of channel names (i.e., width of output columns) in the FAST framework + INTEGER(IntKi), PARAMETER :: MinChanLen = 10 !< The min allowable length of channel names (i.e., width of output columns), used because some modules (like Bladed DLL outputs) have excessively long names INTEGER(IntKi), PARAMETER :: LinChanLen = 200 !< The allowable length of row/column names in linearization files INTEGER(IntKi), PARAMETER :: NWTC_Verbose = 10 !< The maximum level of verbosity diff --git a/modules/nwtc-library/src/NWTC_IO.f90 b/modules/nwtc-library/src/NWTC_IO.f90 index 10ee1f863b..6b74089698 100644 --- a/modules/nwtc-library/src/NWTC_IO.f90 +++ b/modules/nwtc-library/src/NWTC_IO.f90 @@ -22,6 +22,7 @@ MODULE NWTC_IO USE SysSubs USE NWTC_Library_Types ! ProgDesc and other types with copy and other routines for those types + USE IEEE_ARITHMETIC USE VersionInfo IMPLICIT NONE @@ -52,7 +53,8 @@ MODULE NWTC_IO INTEGER(B2Ki), PARAMETER :: FileFmtID_WithTime = 1 !< ID for FAST Output File Format, specifies that the time channel is included in the output file (use if the output can occur at variable times) INTEGER(B2Ki), PARAMETER :: FileFmtID_WithoutTime = 2 !< ID for FAST Output File Format, specifies that the time channel is not included in the output file (used only with constant time-step output) - INTEGER(B2Ki), PARAMETER :: FileFmtID_NoCompressWithoutTime = 3 !< ID for FAST Output File Format, specifies that the time channel is not included in the output file (used only with constant time-step output), and data is not compressed, but written as double precision floats + INTEGER(B2Ki), PARAMETER :: FileFmtID_NoCompressWithoutTime = 3 !< ID for FAST Output File Format, specifies that the time channel is not included in the output file (used only with constant time-step output), and data is not compressed, but written as double-precision floats + INTEGER(B2Ki), PARAMETER :: FileFmtID_ChanLen_In = 4 !< ID for FAST Output File Format, specifies that the time channel is not included in the output file, and channel length is included in the file LOGICAL :: Beep = .TRUE. !< Flag that specifies whether or not to beep for error messages and program terminations. @@ -153,6 +155,13 @@ MODULE NWTC_IO MODULE PROCEDURE ParseSiAry ! Parse an array of single-precision REAL values. END INTERFACE + !> \copydoc nwtc_io::checkr4var + INTERFACE CheckRealVar + MODULE PROCEDURE CheckR4Var ! 4-byte real + MODULE PROCEDURE CheckR8Var ! 8-byte real + MODULE PROCEDURE CheckR16Var ! 16-byte real + END INTERFACE + !> \copydoc nwtc_io::readcvar INTERFACE ReadVar MODULE PROCEDURE ReadCVar @@ -1497,10 +1506,10 @@ SUBROUTINE CheckArgs ( Arg1, ErrStat, Arg2, Flag, InputArgArray ) FirstArgumentSet = .FALSE. SecondArgumentSet = .FALSE. - + IF ( PRESENT(Arg2) ) Arg2 = "" IF ( PRESENT(Flag) ) Flag = "" - + ! Save all arguments in a single argument array; this is primarily used to enable unit testing IF ( PRESENT(InputArgArray) ) THEN ALLOCATE( ArgArray( SIZE(InputArgArray) ) ) @@ -1577,14 +1586,25 @@ SUBROUTINE CheckArgs ( Arg1, ErrStat, Arg2, Flag, InputArgArray ) IF ( .NOT. FirstArgumentSet .AND. .NOT. SecondArgumentSet ) THEN CALL INVALID_SYNTAX( 'the restart capability requires at least one argument: -restart ' ) CALL CLEANUP() - RETURN + RETURN + END IF + + CASE ('VTKLIN') + IF ( FirstArgumentSet .AND. .NOT. SecondArgumentSet ) THEN + Arg2 = Arg1 + Arg1 = "" + END IF + IF ( .NOT. FirstArgumentSet .AND. .NOT. SecondArgumentSet ) THEN + CALL INVALID_SYNTAX( 'the restart capability for vtk mode shapes requires at least one argument: -vtklin ' ) + CALL CLEANUP() + RETURN END IF CASE DEFAULT CALL INVALID_SYNTAX( 'unknown command-line argument given: '//TRIM(FlagIter) ) CALL CLEANUP() RETURN - + END SELECT END DO @@ -1592,7 +1612,7 @@ SUBROUTINE CheckArgs ( Arg1, ErrStat, Arg2, Flag, InputArgArray ) IF ( PRESENT( ErrStat ) ) ErrStat = ErrID_None CALL CLEANUP() - RETURN + RETURN CONTAINS SUBROUTINE CLEANUP() @@ -1756,7 +1776,7 @@ SUBROUTINE ChkRealFmtStr ( RealFmt, RealFmtVar, FmtWidth, ErrStat, ErrMsg ) REAL, PARAMETER :: TestVal = -1.0 ! The value to test the format specifier with. INTEGER :: IOS ! An integer to store the I/O status of the attempted internal write. - INTEGER, PARAMETER :: TestStrLen = 20 ! A parameter for specifying the length of RealStr. + INTEGER, PARAMETER :: TestStrLen = 30 ! A parameter for specifying the length of RealStr. CHARACTER(TestStrLen) :: RealStr ! A string to test writing a real number to. @@ -1863,6 +1883,60 @@ SUBROUTINE CheckIOS ( IOS, Fil, Variable, VarType, ErrStat, ErrMsg, TrapErrors ) RETURN END SUBROUTINE CheckIOS !======================================================================= +!> This routine checks that real values are finite and not NaNs +SUBROUTINE CheckR4Var( RealVar, RealDesc, ErrStat, ErrMsg ) + + REAL(SiKi), INTENT(IN) :: RealVar !< Real value to check + CHARACTER(*),INTENT(IN) :: RealDesc !< description of RealVar + INTEGER, INTENT(OUT) :: ErrStat !< Error status + CHARACTER(*),INTENT(OUT) :: ErrMsg !< Error message + + IF (IEEE_IS_NAN(RealVar) .or. .not. IEEE_IS_FINITE( RealVar) ) THEN + ErrStat = ErrID_Fatal + ErrMsg = trim(RealDesc)//': value is not a finite real number.' + ELSE + ErrStat = ErrID_None + ErrMsg = "" + END IF + +END SUBROUTINE CheckR4Var +!======================================================================= +!> \copydoc nwtc_io::checkr4var +SUBROUTINE CheckR8Var( RealVar, RealDesc, ErrStat, ErrMsg ) + + REAL(R8Ki), INTENT(IN) :: RealVar !< Real value to check + CHARACTER(*),INTENT(IN) :: RealDesc !< description of RealVar + INTEGER, INTENT(OUT) :: ErrStat !< Error status + CHARACTER(*),INTENT(OUT) :: ErrMsg !< Error message + + IF (IEEE_IS_NAN(RealVar) .or. .not. IEEE_IS_FINITE( RealVar) ) THEN + ErrStat = ErrID_Fatal + ErrMsg = trim(RealDesc)//': value is not a finite real number.' + ELSE + ErrStat = ErrID_None + ErrMsg = "" + END IF + +END SUBROUTINE CheckR8Var +!======================================================================= +!> \copydoc nwtc_io::checkr4var +SUBROUTINE CheckR16Var( RealVar, RealDesc, ErrStat, ErrMsg ) + + REAL(QuKi), INTENT(IN) :: RealVar !< Real value to check + CHARACTER(*),INTENT(IN) :: RealDesc !< description of RealVar + INTEGER, INTENT(OUT) :: ErrStat !< Error status + CHARACTER(*),INTENT(OUT) :: ErrMsg !< Error message + + IF (IEEE_IS_NAN(RealVar) .or. .not. IEEE_IS_FINITE( RealVar) ) THEN + ErrStat = ErrID_Fatal + ErrMsg = trim(RealDesc)//': value is not a finite real number.' + ELSE + ErrStat = ErrID_None + ErrMsg = "" + END IF + +END SUBROUTINE CheckR16Var +!======================================================================= !> This routine converts all the text in a string to upper case. SUBROUTINE Conv2UC ( Str ) @@ -2419,12 +2493,13 @@ END FUNCTION GetNVD !======================================================================= !> Let's parse the path name from the name of the given file. !! We'll count everything before (and including) the last "\" or "/". - SUBROUTINE GetPath ( GivenFil, PathName ) + SUBROUTINE GetPath ( GivenFil, PathName, FileName ) ! Argument declarations. - CHARACTER(*), INTENT(IN) :: GivenFil !< The name of the given file. - CHARACTER(*), INTENT(OUT) :: PathName !< The path name of the given file (based solely on the GivenFil text string). + CHARACTER(*), INTENT(IN) :: GivenFil !< The name of the given file. + CHARACTER(*), INTENT(OUT) :: PathName !< The path name of the given file (based solely on the GivenFil text string). + CHARACTER(*), INTENT(OUT), OPTIONAL :: FileName !< The name of the given file without the PathName (based solely on the GivenFil text string). ! Local declarations. @@ -2440,8 +2515,16 @@ SUBROUTINE GetPath ( GivenFil, PathName ) IF ( I == 0 ) THEN ! we don't have a path specified, return '.' PathName = '.'//PathSep + IF (PRESENT(FileName)) FileName = GivenFil ELSE PathName = GivenFil(:I) + IF (PRESENT(FileName)) THEN + IF ( LEN_TRIM(GivenFil) > I ) THEN + FileName = GivenFil(I+1:) + ELSE + FileName = "" + END IF + END IF END IF @@ -2683,6 +2766,22 @@ FUNCTION Int2LStr ( Num ) RETURN END FUNCTION Int2LStr !======================================================================= +!> This function returns true if and only if the first character of the input StringToCheck matches on the of comment characters +!! nwtc_io::commchars. + FUNCTION IsComment(StringToCheck) + ! Note: only the first character in the word is checked. Otherwise we would falsely grab the units '(%)' + LOGICAL :: IsComment + CHARACTER(*), INTENT(IN ) :: StringToCheck ! String to check + + + if ( LEN_TRIM(StringToCheck) > 0 ) then + ISComment = INDEX( CommChars, StringToCheck(1:1) ) > 0 + else + IsComment = .FALSE. + end if + + END FUNCTION IsComment +!======================================================================= !> This routine gets the name of the input file from the InArgth command-line argument, !! removes the extension if there is one, and appends OutExten to the end. SUBROUTINE NameOFile ( InArg, OutExten, OutFile, ErrStat, ErrMsg ) @@ -3083,6 +3182,7 @@ SUBROUTINE OpenFUnkFileAppend ( Un, OutFile, ErrStat, ErrMsg ) RETURN END SUBROUTINE OpenFUnkFileAppend ! ( Un, OutFile [, ErrStat] [, ErrMsg] ) +!======================================================================= !> This routine opens an unformatted input file of RecLen-byte data records !! stored in Big Endian format. SUBROUTINE OpenUInBEFile( Un, InFile, RecLen, ErrStat, ErrMsg ) @@ -3360,8 +3460,8 @@ SUBROUTINE ParseDbAry ( FileInfo, LineNum, AryName, Ary, AryLen, ErrStat, ErrMsg ! Local declarations. INTEGER(IntKi) :: ErrStatLcl ! Error status local to this routine. + INTEGER(IntKi) :: i ! Error status local to this routine. - CHARACTER(20), ALLOCATABLE :: Words (:) ! The array "words" parsed from the line. CHARACTER(*), PARAMETER :: RoutineName = 'ParseDbAry' @@ -3376,14 +3476,6 @@ SUBROUTINE ParseDbAry ( FileInfo, LineNum, AryName, Ary, AryLen, ErrStat, ErrMsg END IF - ALLOCATE ( Words( AryLen ) , STAT=ErrStatLcl ) - IF ( ErrStatLcl /= 0 ) THEN - CALL SetErrStat ( ErrID_Fatal, 'Fatal error allocating memory for the Words array.',ErrStat,ErrMsg,RoutineName ) - CALL Cleanup() - RETURN - ENDIF - - READ (FileInfo%Lines(LineNum),*,IOSTAT=ErrStatLcl) Ary IF ( ErrStatLcl /= 0 ) THEN CALL SetErrStat ( ErrID_Fatal, 'A fatal error occurred when parsing data from "' & @@ -3392,34 +3484,22 @@ SUBROUTINE ParseDbAry ( FileInfo, LineNum, AryName, Ary, AryLen, ErrStat, ErrMsg //TRIM( Num2LStr( FileInfo%FileLine(LineNum) ) )//'.'//NewLine//' >> The text being parsed was :'//NewLine & //' "'//TRIM( FileInfo%Lines(LineNum) )//'"',ErrStat,ErrMsg,RoutineName ) RETURN - CALL Cleanup() ENDIF + + DO i=1,AryLen + call CheckRealVar( Ary(i), AryName, ErrStat, ErrMsg ) + if (ErrStat>= AbortErrLev) return + END DO + IF ( PRESENT(UnEc) ) THEN IF ( UnEc > 0 ) WRITE (UnEc,'(A)') TRIM( FileInfo%Lines(LineNum) ) END IF LineNum = LineNum + 1 - CALL Cleanup() RETURN - !======================================================================= - CONTAINS - !======================================================================= - SUBROUTINE Cleanup ( ) - - ! This subroutine cleans up the parent routine before exiting. - - ! Deallocate the Words array if it had been allocated. - - IF ( ALLOCATED( Words ) ) DEALLOCATE( Words ) - - - RETURN - - END SUBROUTINE Cleanup - END SUBROUTINE ParseDbAry !======================================================================= !> \copydoc nwtc_io::parsechvar @@ -3477,7 +3557,9 @@ SUBROUTINE ParseDbVar ( FileInfo, LineNum, ExpVarName, Var, ErrStat, ErrMsg, UnE NewLine//' "'//TRIM( FileInfo%Lines(LineNum) )//'"', ErrStat, ErrMsg, RoutineName) RETURN ENDIF - + CALL CheckRealVar( Var, ExpVarName, ErrStatLcl, ErrMsg2) + CALL SetErrStat(ErrStatLcl, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF ( PRESENT(UnEc) ) THEN IF ( UnEc > 0 ) WRITE (UnEc,'(1X,A15," = ",A20)') Words END IF @@ -4089,8 +4171,8 @@ SUBROUTINE ParseSiAry ( FileInfo, LineNum, AryName, Ary, AryLen, ErrStat, ErrMsg ! Local declarations. INTEGER(IntKi) :: ErrStatLcl ! Error status local to this routine. + INTEGER(IntKi) :: i - CHARACTER(20), ALLOCATABLE :: Words (:) ! The array "words" parsed from the line. CHARACTER(*), PARAMETER :: RoutineName = 'ParseSiAry' ErrStat = ErrID_None @@ -4103,14 +4185,6 @@ SUBROUTINE ParseSiAry ( FileInfo, LineNum, AryName, Ary, AryLen, ErrStat, ErrMsg RETURN END IF - ALLOCATE ( Words( AryLen ) , STAT=ErrStatLcl ) - IF ( ErrStatLcl /= 0 ) THEN - CALL SetErrStat ( ErrID_Fatal, 'Fatal error allocating memory for the Words array.', ErrStat, ErrMsg, RoutineName ) - CALL Cleanup() - RETURN - ENDIF - - READ (FileInfo%Lines(LineNum),*,IOSTAT=ErrStatLcl) Ary IF ( ErrStatLcl /= 0 ) THEN CALL SetErrStat ( ErrID_Fatal, NewLine//' >> A fatal error occurred when parsing data from "' & @@ -4118,7 +4192,6 @@ SUBROUTINE ParseSiAry ( FileInfo, LineNum, AryName, Ary, AryLen, ErrStat, ErrMsg ' >> The "'//TRIM( AryName )//'" array was not assigned valid REAL values on line #' & //TRIM( Num2LStr( FileInfo%FileLine(LineNum) ) )//'.'//NewLine//' >> The text being parsed was :'//NewLine & //' "'//TRIM( FileInfo%Lines(LineNum) )//'"', ErrStat, ErrMsg, RoutineName ) - CALL Cleanup() RETURN ENDIF @@ -4126,27 +4199,15 @@ SUBROUTINE ParseSiAry ( FileInfo, LineNum, AryName, Ary, AryLen, ErrStat, ErrMsg IF ( UnEc > 0 ) WRITE (UnEc,'(A)') TRIM( FileInfo%Lines(LineNum) ) END IF + DO i=1,AryLen + call CheckRealVar( Ary(i), AryName, ErrStat, ErrMsg ) + if (ErrStat>= AbortErrLev) return + END DO + LineNum = LineNum + 1 - CALL Cleanup ( ) - RETURN - !======================================================================= - CONTAINS - !======================================================================= - SUBROUTINE Cleanup ( ) - - ! This subroutine cleans up the parent routine before exiting. - - ! Deallocate the Words array if it had been allocated. - - IF ( ALLOCATED( Words ) ) DEALLOCATE( Words ) - - RETURN - - END SUBROUTINE Cleanup - END SUBROUTINE ParseSiAry !======================================================================= !> \copydoc nwtc_io::parsechvar @@ -4204,6 +4265,8 @@ SUBROUTINE ParseSiVar ( FileInfo, LineNum, ExpVarName, Var, ErrStat, ErrMsg, UnE RETURN ENDIF + CALL CheckRealVar( Var, ExpVarName, ErrStat, ErrMsg) + IF ( PRESENT(UnEc) ) THEN IF ( UnEc > 0 ) WRITE (UnEc,'(1X,A15," = ",A20)') Words END IF @@ -5043,14 +5106,14 @@ SUBROUTINE ReadFASTbin ( UnIn, Init, FASTdata, ErrStat, ErrMsg ) ! Argument declarations. - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< An optional error level to be returned to the calling routine. - INTEGER(IntKi), INTENT(INOUT) :: UnIn !< The IO unit for the FAST binary file. + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< An optional error level to be returned to the calling routine. + INTEGER(IntKi), INTENT(INOUT) :: UnIn !< The IO unit for the FAST binary file. - LOGICAL, INTENT(IN) :: Init !< A flag to tell the routine to read only the file header for initialization purposes. + LOGICAL, INTENT(IN) :: Init !< A flag to tell the routine to read only the file header for initialization purposes. - CHARACTER(*), INTENT( OUT) :: ErrMsg !< An optional error message to be returned to the calling routine. + CHARACTER(*), INTENT( OUT) :: ErrMsg !< An optional error message to be returned to the calling routine. - TYPE (FASTdataType), INTENT(INOUT) :: FASTdata !< The derived type for holding FAST output data. + TYPE (FASTdataType), INTENT(INOUT) :: FASTdata !< The derived type for holding FAST output data. ! Local declarations. @@ -5071,17 +5134,18 @@ SUBROUTINE ReadFASTbin ( UnIn, Init, FASTdata, ErrStat, ErrMsg ) INTEGER(IntKi) :: IRow ! The row index used for DO loops. INTEGER(IntKi) :: LenDesc ! The length of the description string, DescStr. INTEGER(IntKi), PARAMETER :: MaxLenDesc = 1024 ! The maximum allowed length of the description string, DescStr. - INTEGER(IntKi), PARAMETER :: MaxChrLen = 10 ! The maximum length for channel names and units. - + INTEGER(IntKi) :: ChanLen2 ! The lengths of channel names in the file + INTEGER(B4Ki), ALLOCATABLE :: TmpTimeArray(:) ! This array holds the normalized time channel that was read from the binary file. INTEGER(B4Ki) :: Tmp4BInt ! This scalar temporarially holds a 4-byte integer that was stored in the binary file INTEGER(B2Ki) :: FileType ! The type of FAST data file (1: Time channel included in file; 2: Time stored as start time and step). + INTEGER(B2Ki) :: Tmp2BInt ! This scalar temporarially holds a 2-byte integer that was stored in the binary file. INTEGER(B2Ki), ALLOCATABLE :: TmpInArray(:,:) ! This array holds the normalized channels that were read from the binary file. INTEGER(R8Ki), ALLOCATABLE :: TmpR8InArray(:,:) ! This array holds the uncompressed channels that were read from the binary file. INTEGER(B1Ki), ALLOCATABLE :: DescStrASCII(:) ! The ASCII equivalent of DescStr. - INTEGER(B1Ki) :: TmpStrASCII(MaxChrLen) ! The temporary ASCII equivalent of a channel name or units. + INTEGER(B1Ki), ALLOCATABLE :: TmpStrASCII(:) ! The temporary ASCII equivalent of a channel name or units. INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -5119,6 +5183,19 @@ SUBROUTINE ReadFASTbin ( UnIn, Init, FASTdata, ErrStat, ErrMsg ) RETURN ENDIF + + IF (FileType == FileFmtID_ChanLen_In) THEN + READ (UnIn, IOSTAT=ErrStat2) Tmp2BInt + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat ( ErrID_Fatal, 'Fatal error reading ChanLen from file "'//TRIM( FASTdata%File )//'".', ErrStat, ErrMsg, RoutineName ) + CALL Cleanup() + RETURN + ENDIF + ChanLen2 = Tmp2BInt + ELSE + ChanLen2 = 10 + END IF + READ (UnIn, IOSTAT=ErrStat2) Tmp4BInt IF ( ErrStat2 /= 0 ) THEN CALL SetErrStat ( ErrID_Fatal, 'Fatal error reading the number of channels from file "' & @@ -5312,6 +5389,13 @@ SUBROUTINE ReadFASTbin ( UnIn, Init, FASTdata, ErrStat, ErrMsg ) FASTdata%Descr(IChr:IChr) = CHAR( DescStrASCII(IChr) ) END DO + + ALLOCATE ( TmpStrASCII( ChanLen2 ) , STAT=ErrStat2 ) + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat ( ErrID_Fatal, 'Fatal error allocating memory for the DescStrASCII array.', ErrStat, ErrMsg, RoutineName ) + CALL Cleanup() + RETURN + ENDIF TmpStrASCII(:) = ICHAR( ' ' ) DO IChan=1,FASTdata%NumChans+1 READ (UnIn, IOSTAT=ErrStat2) TmpStrASCII @@ -5322,7 +5406,7 @@ SUBROUTINE ReadFASTbin ( UnIn, Init, FASTdata, ErrStat, ErrMsg ) RETURN ENDIF FASTdata%ChanNames(IChan) = '' - DO IChr=1,MaxChrLen + DO IChr=1,ChanLen2 FASTdata%ChanNames(IChan)(IChr:IChr) = CHAR( TmpStrASCII(IChr) ) END DO END DO @@ -5337,7 +5421,7 @@ SUBROUTINE ReadFASTbin ( UnIn, Init, FASTdata, ErrStat, ErrMsg ) RETURN ENDIF FASTdata%ChanUnits(IChan) = '' - DO IChr=1,MaxChrLen + DO IChr=1,ChanLen2 FASTdata%ChanUnits(IChan)(IChr:IChr) = CHAR( TmpStrASCII(IChr) ) END DO END DO @@ -5394,15 +5478,17 @@ SUBROUTINE ReadFASTbin ( UnIn, Init, FASTdata, ErrStat, ErrMsg ) END DO ! IRow=1,FASTdata%NumRecs - DO IRow=1,FASTdata%NumRecs - IF ( FileType == FileFmtID_NoCompressWithoutTime ) THEN + IF ( FileType == FileFmtID_NoCompressWithoutTime ) THEN + DO IRow=1,FASTdata%NumRecs FASTdata%Data(IRow,2:) = REAL(TmpInArray(IRow,:), ReKi) - ELSE + END DO ! IRow=1,FASTdata%NumRecs + ELSE + DO IRow=1,FASTdata%NumRecs ! Denormalize the data one row at a time and store it in the FASTdata%Data array. FASTdata%Data(IRow,2:) = ( TmpInArray(IRow,:) - ColOff(:) )/ColScl(:) - END IF + END DO ! IRow=1,FASTdata%NumRecs + END IF - END DO ! IRow=1,FASTdata%NumRecs CALL Cleanup( ) @@ -5423,6 +5509,7 @@ SUBROUTINE Cleanup ( ) IF ( ALLOCATED( ColOff ) ) DEALLOCATE( ColOff ) IF ( ALLOCATED( ColScl ) ) DEALLOCATE( ColScl ) IF ( ALLOCATED( DescStrASCII ) ) DEALLOCATE( DescStrASCII ) + IF ( ALLOCATED( TmpStrASCII ) ) DEALLOCATE( TmpStrASCII ) IF ( ALLOCATED( TmpInArray ) ) DEALLOCATE( TmpInArray ) IF ( ALLOCATED( TmpR8InArray ) ) DEALLOCATE( TmpR8InArray ) IF ( ALLOCATED( TmpTimeArray ) ) DEALLOCATE( TmpTimeArray ) @@ -5621,7 +5708,7 @@ END SUBROUTINE ReadLAry !============================================================================= !> This routine reads a line from the specified input file and returns the non-comment !! portion of the line. - SUBROUTINE ReadLine ( UnIn, CommChars, Line, LineLen, IOStat ) + SUBROUTINE ReadLine ( UnIn, CommentChars, Line, LineLen, IOStat ) ! Argument declarations. @@ -5630,7 +5717,7 @@ SUBROUTINE ReadLine ( UnIn, CommChars, Line, LineLen, IOStat ) INTEGER, INTENT(IN) :: UnIn !< The unit number for the file being read. INTEGER, INTENT(OUT) :: LineLen !< The length of the line returned from ReadLine(). - CHARACTER(*), INTENT(IN) :: CommChars !< The list of possible comment characters. + CHARACTER(*), INTENT(IN) :: CommentChars !< The list of possible comment characters. CHARACTER(*), INTENT(OUT) :: Line !< The decommented line being returned to the calling routine. ! Local declarations. @@ -5638,7 +5725,7 @@ SUBROUTINE ReadLine ( UnIn, CommChars, Line, LineLen, IOStat ) INTEGER :: CommLoc ! The left-most location of a given comment character in the Line. INTEGER :: FirstComm ! The location of first comment character in the Line. INTEGER :: IC ! The index for the character location in the string. - INTEGER :: NumCommChars ! The number of comment characters in the CommChars array. + INTEGER :: NumCommChars ! The number of comment characters in the CommentChars array. READ (UnIn,'(A)',IOSTAT=IOStat) Line @@ -5650,14 +5737,14 @@ SUBROUTINE ReadLine ( UnIn, CommChars, Line, LineLen, IOStat ) ENDIF LineLen = LEN_TRIM( Line ) - NumCommChars = LEN_TRIM( CommChars ) + NumCommChars = LEN_TRIM( CommentChars ) IF ( ( NumCommChars == 0 ) .OR. ( LineLen == 0 ) ) RETURN FirstComm = MIN( LEN( Line ), LineLen + 1 ) DO IC=1,NumCommChars - CommLoc = INDEX( Line, CommChars(IC:IC) ) + CommLoc = INDEX( Line, CommentChars(IC:IC) ) IF ( CommLoc > 0 ) THEN FirstComm = MIN( CommLoc, FirstComm ) ENDIF @@ -5869,8 +5956,12 @@ SUBROUTINE ReadR4Ary ( UnIn, Fil, Ary, AryLen, AryName, AryDescr, ErrStat, ErrMs READ (UnIn,*,IOSTAT=IOS) ( Ary(Ind), Ind=1,AryLen ) CALL CheckIOS ( IOS, Fil, TRIM( AryName ), NumType, ErrStat, ErrMsg ) + IF (ErrStat >= AbortErrLev) RETURN - IF (ErrStat >= AbortErrLev) RETURN + DO Ind=1,AryLen + CALL CheckRealVar( Ary(Ind), AryName, ErrStat, ErrMsg) + IF (ErrStat >= AbortErrLev) RETURN + END DO IF ( PRESENT(UnEc) ) THEN IF ( UnEc > 0 ) THEN @@ -5963,6 +6054,11 @@ SUBROUTINE ReadR8Ary ( UnIn, Fil, Ary, AryLen, AryName, AryDescr, ErrStat, ErrMs IF (ErrStat >= AbortErrLev) RETURN + DO Ind=1,AryLen + CALL CheckRealVar( Ary(Ind), AryName, ErrStat, ErrMsg) + IF (ErrStat >= AbortErrLev) RETURN + END DO + IF ( PRESENT(UnEc) ) THEN IF ( UnEc > 0 ) THEN WRITE( UnEc, Ec_ReAryFrmt ) TRIM( AryName ), AryDescr, Ary(1:MIN(AryLen,NWTC_MaxAryLen)) @@ -6052,6 +6148,11 @@ SUBROUTINE ReadR16Ary ( UnIn, Fil, Ary, AryLen, AryName, AryDescr, ErrStat, ErrM IF (ErrStat >= AbortErrLev) RETURN + DO Ind=1,AryLen + CALL CheckRealVar( Ary(Ind), AryName, ErrStat, ErrMsg) + IF (ErrStat >= AbortErrLev) RETURN + END DO + IF ( PRESENT(UnEc) ) THEN IF ( UnEc > 0 ) THEN WRITE( UnEc, Ec_ReAryFrmt ) TRIM( AryName ), AryDescr, Ary(1:MIN(AryLen,NWTC_MaxAryLen)) @@ -6137,8 +6238,9 @@ SUBROUTINE ReadR4AryLines ( UnIn, Fil, Ary, AryLen, AryName, AryDescr, ErrStat, READ (UnIn,*,IOSTAT=IOS) Ary(Ind) CALL CheckIOS ( IOS, Fil, TRIM( AryName )//'('//TRIM( Num2LStr( Ind ) )//')', NumType, ErrStat, ErrMsg ) - - IF (ErrStat >= AbortErrLev) RETURN + IF (ErrStat >= AbortErrLev) RETURN + CALL CheckRealVar( Ary(Ind), AryName, ErrStat, ErrMsg) + IF (ErrStat >= AbortErrLev) RETURN IF ( PRESENT(UnEc) ) THEN IF ( UnEc > 0 ) & @@ -6185,8 +6287,9 @@ SUBROUTINE ReadR8AryLines ( UnIn, Fil, Ary, AryLen, AryName, AryDescr, ErrStat, READ (UnIn,*,IOSTAT=IOS) Ary(Ind) CALL CheckIOS ( IOS, Fil, TRIM( AryName )//'('//TRIM( Num2LStr( Ind ) )//')', NumType, ErrStat, ErrMsg ) - - IF (ErrStat >= AbortErrLev) RETURN + IF (ErrStat >= AbortErrLev) RETURN + CALL CheckRealVar( Ary(Ind), AryName, ErrStat, ErrMsg) + IF (ErrStat >= AbortErrLev) RETURN IF ( PRESENT(UnEc) ) THEN IF ( UnEc > 0 ) & @@ -6233,8 +6336,9 @@ SUBROUTINE ReadR16AryLines ( UnIn, Fil, Ary, AryLen, AryName, AryDescr, ErrStat, READ (UnIn,*,IOSTAT=IOS) Ary(Ind) CALL CheckIOS ( IOS, Fil, TRIM( AryName )//'('//TRIM( Num2LStr( Ind ) )//')', NumType, ErrStat, ErrMsg ) - - IF (ErrStat >= AbortErrLev) RETURN + IF (ErrStat >= AbortErrLev) RETURN + CALL CheckRealVar( Ary(Ind), AryName, ErrStat, ErrMsg) + IF (ErrStat >= AbortErrLev) RETURN IF ( PRESENT(UnEc) ) THEN IF ( UnEc > 0 ) & @@ -6282,8 +6386,9 @@ SUBROUTINE ReadR4Var ( UnIn, Fil, Var, VarName, VarDescr, ErrStat, ErrMsg, UnEc READ (Word,*,IOSTAT=IOS) Var CALL CheckIOS ( IOS, Fil, VarName, NumType, ErrStat, ErrMsg ) - - IF (ErrStat >= AbortErrLev) RETURN + IF (ErrStat >= AbortErrLev) RETURN + CALL CheckRealVar( Var, VarName, ErrStat, ErrMsg) + IF (ErrStat >= AbortErrLev) RETURN IF ( PRESENT(UnEc) ) THEN @@ -6328,8 +6433,9 @@ SUBROUTINE ReadR4VarWDefault ( UnIn, Fil, Var, VarName, VarDescr, VarDefault, Er READ (Word,*,IOSTAT=IOS) Var CALL CheckIOS ( IOS, Fil, VarName, NumType, ErrStat, ErrMsg ) - - IF (ErrStat >= AbortErrLev) RETURN + IF (ErrStat >= AbortErrLev) RETURN + CALL CheckRealVar( Var, VarName, ErrStat, ErrMsg) + IF (ErrStat >= AbortErrLev) RETURN ELSE Var = VarDefault END IF @@ -6375,9 +6481,9 @@ SUBROUTINE ReadR8Var ( UnIn, Fil, Var, VarName, VarDescr, ErrStat, ErrMsg, UnEc READ (Word,*,IOSTAT=IOS) Var CALL CheckIOS ( IOS, Fil, VarName, NumType, ErrStat, ErrMsg ) - - - IF (ErrStat >= AbortErrLev) RETURN + IF (ErrStat >= AbortErrLev) RETURN + CALL CheckRealVar( Var, VarName, ErrStat, ErrMsg) + IF (ErrStat >= AbortErrLev) RETURN IF ( PRESENT(UnEc) ) THEN IF ( UnEc > 0 ) & @@ -6422,8 +6528,9 @@ SUBROUTINE ReadR8VarWDefault ( UnIn, Fil, Var, VarName, VarDescr, VarDefault, Er READ (Word,*,IOSTAT=IOS) Var CALL CheckIOS ( IOS, Fil, VarName, NumType, ErrStat, ErrMsg ) - - IF (ErrStat >= AbortErrLev) RETURN + IF (ErrStat >= AbortErrLev) RETURN + CALL CheckRealVar( Var, VarName, ErrStat, ErrMsg) + IF (ErrStat >= AbortErrLev) RETURN ELSE Var = VarDefault END IF @@ -6475,9 +6582,9 @@ SUBROUTINE ReadR16Var ( UnIn, Fil, Var, VarName, VarDescr, ErrStat, ErrMsg, UnEc READ (Word,*,IOSTAT=IOS) Var CALL CheckIOS ( IOS, Fil, VarName, NumType, ErrStat, ErrMsg ) - - - IF (ErrStat >= AbortErrLev) RETURN + IF (ErrStat >= AbortErrLev) RETURN + CALL CheckRealVar( Var, VarName, ErrStat, ErrMsg) + IF (ErrStat >= AbortErrLev) RETURN IF ( PRESENT(UnEc) ) THEN IF ( UnEc > 0 ) & @@ -6522,8 +6629,9 @@ SUBROUTINE ReadR16VarWDefault ( UnIn, Fil, Var, VarName, VarDescr, VarDefault, E READ (Word,*,IOSTAT=IOS) Var CALL CheckIOS ( IOS, Fil, VarName, NumType, ErrStat, ErrMsg ) - - IF (ErrStat >= AbortErrLev) RETURN + IF (ErrStat >= AbortErrLev) RETURN + CALL CheckRealVar( Var, VarName, ErrStat, ErrMsg) + IF (ErrStat >= AbortErrLev) RETURN ELSE Var = VarDefault END IF @@ -6625,8 +6733,6 @@ RECURSIVE SUBROUTINE ScanComFile ( FirstFile, ThisFile, LastFile, StartLine, Las LOGICAL :: FileFound ! A flag that is set to TRUE if this file has already been read. LOGICAL :: IsOpen ! A flag that is set to TRUE if this file is already open. -! Should the comment characters be passed to this routine instead of being hard coded? -mlb - CHARACTER(3), PARAMETER :: CommChars = '!#%' ! Comment characters that mark the end of useful input. CHARACTER(1024) :: FileName ! The name of this file being processed. CHARACTER(1024) :: IncFileName ! The name of a file that this one includes. CHARACTER(512) :: Line ! The contents of a line returned from ReadLine() with comment removed. @@ -6888,9 +6994,6 @@ SUBROUTINE WrBinFAST(FileName, FileID, DescStr, ChanName, ChanUnit, TimeData, Al IMPLICIT NONE - INTEGER(IntKi), PARAMETER :: LenName = ChanLen ! Number of characters allowed in a channel name - INTEGER(IntKi), PARAMETER :: LenUnit = ChanLen ! Number of characters allowed in a channel unit - ! Passed data (sorted by element size, then alphabetical) REAL(DbKi), INTENT(IN) :: TimeData(:) !< The time being output to the file (if using FileFmtID_WithoutTime: element 1 is the first output time, element 2 is the delta t) @@ -6898,8 +7001,8 @@ SUBROUTINE WrBinFAST(FileName, FileID, DescStr, ChanName, ChanUnit, TimeData, Al INTEGER(IntKi), INTENT(OUT):: ErrStat !< Indicates whether an error occurred (see NWTC_Library) INTEGER(B2Ki), INTENT(IN) :: FileID !< File ID, used to determine format of output file (use FileFmtID_WithTime or FileFmtID_WithoutTime) - CHARACTER(LenName),INTENT(IN) :: ChanName(:) !< The output channel names (including Time) - CHARACTER(LenUnit),INTENT(IN) :: ChanUnit(:) !< The output channel units (including Time) + CHARACTER(ChanLen),INTENT(IN) :: ChanName(:) !< The output channel names (including Time) + CHARACTER(ChanLen),INTENT(IN) :: ChanUnit(:) !< The output channel units (including Time) CHARACTER(*), INTENT(IN) :: DescStr !< Description to write to the binary file (e.g., program version, date, & time) CHARACTER(*), INTENT(OUT):: ErrMsg !< Error message associated with the ErrStat CHARACTER(*), INTENT(IN) :: FileName !< Name of the file to write the output in @@ -6947,6 +7050,8 @@ SUBROUTINE WrBinFAST(FileName, FileID, DescStr, ChanName, ChanUnit, TimeData, Al INTEGER(B1Ki), ALLOCATABLE :: ChanNameASCII(:) ! The ASCII equivalent of ChanName INTEGER(B1Ki), ALLOCATABLE :: ChanUnitASCII(:) ! The ASCII equivalent of ChanUnit + INTEGER(IntKi) :: LenName ! Max number of characters in a channel name + CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary error message CHARACTER(*), PARAMETER :: RoutineName = 'WrBinFAST' @@ -6980,11 +7085,20 @@ SUBROUTINE WrBinFAST(FileName, FileID, DescStr, ChanName, ChanUnit, TimeData, Al !............................................................................................................................... ! Allocate arrays !............................................................................................................................... + IF (FileID==FileFmtID_ChanLen_In) THEN + LenName = 1 + DO IC = 1,NumOutChans+1 + LenName = MAX(LenName,LEN_TRIM(ChanName(IC))) + LenName = MAX(LenName,LEN_TRIM(ChanUnit(IC))) + END DO + ELSE + LenName = 10 + END IF CALL AllocAry( ChanNameASCII, (1+NumOutChans)*LenName , 'temporary channel name array (ChanNameASCII)', ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL AllocAry( ChanUnitASCII, (1+NumOutChans)*LenUnit, 'temporary channel unit names (ChanUnitASCII)', ErrStat2, ErrMsg2 ) + CALL AllocAry( ChanUnitASCII, (1+NumOutChans)*LenName, 'temporary channel unit names (ChanUnitASCII)', ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL AllocAry( DescStrASCII, LenDesc, 'temporary file description (DescStrASCII)', ErrStat2, ErrMsg2 ) @@ -7045,7 +7159,7 @@ SUBROUTINE WrBinFAST(FileName, FileID, DescStr, ChanName, ChanUnit, TimeData, Al ! Channel units (ChanUnit) J = 1 DO IC = 1,SIZE(ChanUnit) - DO I=1,LenUnit + DO I=1,LenName ChanUnitASCII(J) = IACHAR( ChanUnit(IC)(I:I) ) J = J + 1 END DO @@ -7144,6 +7258,15 @@ SUBROUTINE WrBinFAST(FileName, FileID, DescStr, ChanName, ChanUnit, TimeData, Al RETURN END IF + IF (FileID==FileFmtID_ChanLen_In) THEN + WRITE (UnIn, IOSTAT=ErrStat2) INT( LenName , B2Ki ) ! Length of channel names + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat( ErrID_Fatal, 'Error writing ChanLen to the FAST binary file.', ErrStat, ErrMsg, RoutineName ) + CALL Cleanup( ) + RETURN + END IF + END IF + WRITE (UnIn, IOSTAT=ErrStat2) INT( NumOutChans , B4Ki ) ! The number of output channels IF ( ErrStat2 /= 0 ) THEN CALL SetErrStat( ErrID_Fatal, 'Error writing NumOutChans to the FAST binary file.', ErrStat, ErrMsg, RoutineName ) @@ -8108,7 +8231,10 @@ SUBROUTINE ReadVTK_SP_info( FileName, descr, dims, origin, gridSpacing, vecLabel ELSE sz = len(Line) Line = Line(12:sz) - READ(Line,*) dims + READ(Line,*, IOSTAT=ErrStat2) dims + if (ErrStat2 /= 0) then + CALL SetErrStat( ErrID_Fatal, 'Error reading "dims".', ErrStat, ErrMsg, RoutineName ) + end if END IF ! Origin @@ -8123,7 +8249,11 @@ SUBROUTINE ReadVTK_SP_info( FileName, descr, dims, origin, gridSpacing, vecLabel ELSE sz = len(Line) Line = Line(8:sz) - READ(Line,*) origin + READ(Line,*, IOSTAT=ErrStat2) origin + if (ErrStat2 /= 0) then + CALL SetErrStat( ErrID_Fatal, 'Error reading "origin".', ErrStat, ErrMsg, RoutineName ) + end if + END IF ! Spacing @@ -8138,7 +8268,11 @@ SUBROUTINE ReadVTK_SP_info( FileName, descr, dims, origin, gridSpacing, vecLabel ELSE sz = len(Line) Line = Line(9:sz) - READ(Line,*) gridSpacing + READ(Line,*,IOSTAT=ErrStat2) gridSpacing + if (ErrStat2 /= 0) then + CALL SetErrStat( ErrID_Fatal, 'Error reading "gridSpacing".', ErrStat, ErrMsg, RoutineName ) + end if + END IF ! Point Data @@ -8153,7 +8287,10 @@ SUBROUTINE ReadVTK_SP_info( FileName, descr, dims, origin, gridSpacing, vecLabel ELSE sz = len(Line) Line = Line(12:sz) - READ(Line,*) nPts + READ(Line,*,IOSTAT=ErrStat2) nPts + if (ErrStat2 /= 0) then + CALL SetErrStat( ErrID_Fatal, 'Error reading "nPts".', ErrStat, ErrMsg, RoutineName ) + end if END IF ! Vector Label @@ -8188,23 +8325,24 @@ END SUBROUTINE ReadVTK_SP_info !> This routine reads the vector data for a vtk, ascii, structured_points dataset file, !! The Unit number of the file is already assumed to be valid via a previous call to !! ReadVTK_SP_info. - SUBROUTINE ReadVTK_SP_vectors( FileName, Un, dims, gridVals, ErrStat, ErrMsg ) + SUBROUTINE ReadVTK_SP_vectors( Un, dims, gridVals, ErrStat, ErrMsg ) - CHARACTER(*) , INTENT(IN ) :: FileName !< Name of output file INTEGER(IntKi) , INTENT(IN ) :: Un !< unit number of opened file INTEGER(IntKi) , INTENT(IN ) :: dims(3) !< dimension of the 3D grid (nX,nY,nZ) - REAL(ReKi) , INTENT( OUT) :: gridVals(:,:,:,:) !< 3D array of data, size (nX,nY,nZ), must be pre-allocated + REAL(ReKi) , INTENT( OUT) :: gridVals(:,:,:,:) !< 4D array of data, size (3,nX,nY,nZ), must be pre-allocated INTEGER(IntKi) , INTENT( OUT) :: ErrStat !< error level/status of OpenFOutFile operation CHARACTER(*) , INTENT( OUT) :: ErrMsg !< message when error occurs INTEGER(IntKi) :: ErrStat2 ! local error level/status of OpenFOutFile operation - CHARACTER(ErrMsgLen) :: ErrMsg2 ! local message when error occurs CHARACTER(*), PARAMETER :: RoutineName = 'ReadVTK_SP_vectors' ErrStat = ErrID_None ErrMsg = '' - READ(Un,*) gridVals(1:3,1:dims(1),1:dims(2),1:dims(3)) + READ(Un,*, IOSTAT=ErrStat2) gridVals(1:3,1:dims(1),1:dims(2),1:dims(3)) + if (ErrStat2 /= 0) then + CALL SetErrStat( ErrID_Fatal, 'Error reading vector data.', ErrStat, ErrMsg, RoutineName ) + end if close(Un) diff --git a/modules/nwtc-library/src/NWTC_Library_Types.f90 b/modules/nwtc-library/src/NWTC_Library_Types.f90 index eb6d34fb0b..68b8fe90f1 100644 --- a/modules/nwtc-library/src/NWTC_Library_Types.f90 +++ b/modules/nwtc-library/src/NWTC_Library_Types.f90 @@ -3,7 +3,7 @@ ! WARNING This file is generated automatically by the FAST registry. ! Do not edit. Your changes to this file will be lost. ! -! FAST Registry (v3.02.00, 23-Jul-2016) +! FAST Registry !********************************************************************************************************************************* ! NWTC_Library_Types !................................................................................................................................. @@ -26,9 +26,8 @@ ! ! bjj: modifications made !********************************************************************************************************************************* -!> This module contains many of the user-defined types used in NWTC_Library. It also contains copy, destroy, pack, and -!! unpack routines associated with each defined data type. This code is automatically generated by the FAST Registry, but -!! was modified for the specific needs of NWTC Library. +!> This module contains the user-defined types needed in NWTC_Library. It also contains copy, destroy, pack, and +!! unpack routines associated with each defined data type. This code is automatically generated by the FAST Registry. MODULE NWTC_Library_Types !--------------------------------------------------------------------------------------------------------------------------------- USE SysSubs @@ -60,14 +59,6 @@ MODULE NWTC_Library_Types INTEGER(IntKi) :: SignM !< Multiplier for output channel; usually -1 (minus) or 0 (invalid channel) [-] END TYPE OutParmType ! ======================= -! ========= OutParmFFType ======= - TYPE, PUBLIC :: OutParmFFType - INTEGER(IntKi) :: Indx !< An index into AllOuts array where this channel is computed/stored [-] - CHARACTER(ChanLenFF) :: Name !< Name of the output channel [-] - CHARACTER(ChanLenFF) :: Units !< Units this channel is specified in [-] - INTEGER(IntKi) :: SignM !< Multiplier for output channel; usually -1 (minus) or 0 (invalid channel) [-] - END TYPE OutParmFFType -! ======================= ! ========= FileInfoType ======= TYPE, PUBLIC :: FileInfoType INTEGER(IntKi) :: NumLines @@ -214,18 +205,18 @@ SUBROUTINE NWTC_Library_PackProgDesc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSta Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%Name) - IntKiBuf(Int_Xferred) = ICHAR(InData%Name(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%Ver) - IntKiBuf(Int_Xferred) = ICHAR(InData%Ver(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%Date) - IntKiBuf(Int_Xferred) = ICHAR(InData%Date(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(InData%Name) + IntKiBuf(Int_Xferred) = ICHAR(InData%Name(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%Ver) + IntKiBuf(Int_Xferred) = ICHAR(InData%Ver(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%Date) + IntKiBuf(Int_Xferred) = ICHAR(InData%Date(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE NWTC_Library_PackProgDesc SUBROUTINE NWTC_Library_UnPackProgDesc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -241,12 +232,6 @@ SUBROUTINE NWTC_Library_UnPackProgDesc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -262,18 +247,18 @@ SUBROUTINE NWTC_Library_UnPackProgDesc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%Name) - OutData%Name(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Ver) - OutData%Ver(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Date) - OutData%Date(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%Name) + OutData%Name(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%Ver) + OutData%Ver(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%Date) + OutData%Date(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE NWTC_Library_UnPackProgDesc SUBROUTINE NWTC_Library_CopyFASTdataType( SrcFASTdataTypeData, DstFASTdataTypeData, CtrlCode, ErrStat, ErrMsg ) @@ -439,20 +424,20 @@ SUBROUTINE NWTC_Library_PackFASTdataType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Er Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%File) - IntKiBuf(Int_Xferred) = ICHAR(InData%File(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%Descr) - IntKiBuf(Int_Xferred) = ICHAR(InData%Descr(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumChans - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumRecs - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%TimeStep - Db_Xferred = Db_Xferred + 1 + DO I = 1, LEN(InData%File) + IntKiBuf(Int_Xferred) = ICHAR(InData%File(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%Descr) + IntKiBuf(Int_Xferred) = ICHAR(InData%Descr(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%NumChans + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumRecs + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%TimeStep + Db_Xferred = Db_Xferred + 1 IF ( .NOT. ALLOCATED(InData%ChanNames) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -463,12 +448,12 @@ SUBROUTINE NWTC_Library_PackFASTdataType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ChanNames,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%ChanNames,1), UBOUND(InData%ChanNames,1) + DO i1 = LBOUND(InData%ChanNames,1), UBOUND(InData%ChanNames,1) DO I = 1, LEN(InData%ChanNames) IntKiBuf(Int_Xferred) = ICHAR(InData%ChanNames(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%ChanUnits) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -480,12 +465,12 @@ SUBROUTINE NWTC_Library_PackFASTdataType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ChanUnits,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%ChanUnits,1), UBOUND(InData%ChanUnits,1) + DO i1 = LBOUND(InData%ChanUnits,1), UBOUND(InData%ChanUnits,1) DO I = 1, LEN(InData%ChanUnits) IntKiBuf(Int_Xferred) = ICHAR(InData%ChanUnits(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%Data) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -500,8 +485,12 @@ SUBROUTINE NWTC_Library_PackFASTdataType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Data,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Data)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Data))-1 ) = PACK(InData%Data,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Data) + DO i2 = LBOUND(InData%Data,2), UBOUND(InData%Data,2) + DO i1 = LBOUND(InData%Data,1), UBOUND(InData%Data,1) + ReKiBuf(Re_Xferred) = InData%Data(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE NWTC_Library_PackFASTdataType @@ -518,12 +507,6 @@ SUBROUTINE NWTC_Library_UnPackFASTdataType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -539,20 +522,20 @@ SUBROUTINE NWTC_Library_UnPackFASTdataType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%File) - OutData%File(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Descr) - OutData%Descr(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%NumChans = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumRecs = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TimeStep = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + DO I = 1, LEN(OutData%File) + OutData%File(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%Descr) + OutData%Descr(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%NumChans = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumRecs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TimeStep = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ChanNames not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -566,19 +549,12 @@ SUBROUTINE NWTC_Library_UnPackFASTdataType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ChanNames.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%ChanNames,1), UBOUND(OutData%ChanNames,1) + DO i1 = LBOUND(OutData%ChanNames,1), UBOUND(OutData%ChanNames,1) DO I = 1, LEN(OutData%ChanNames) OutData%ChanNames(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ChanUnits not allocated Int_Xferred = Int_Xferred + 1 @@ -593,19 +569,12 @@ SUBROUTINE NWTC_Library_UnPackFASTdataType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ChanUnits.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%ChanUnits,1), UBOUND(OutData%ChanUnits,1) + DO i1 = LBOUND(OutData%ChanUnits,1), UBOUND(OutData%ChanUnits,1) DO I = 1, LEN(OutData%ChanUnits) OutData%ChanUnits(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Data not allocated Int_Xferred = Int_Xferred + 1 @@ -623,15 +592,12 @@ SUBROUTINE NWTC_Library_UnPackFASTdataType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Data.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Data)>0) OutData%Data = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Data))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Data) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Data,2), UBOUND(OutData%Data,2) + DO i1 = LBOUND(OutData%Data,1), UBOUND(OutData%Data,1) + OutData%Data(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE NWTC_Library_UnPackFASTdataType @@ -732,18 +698,18 @@ SUBROUTINE NWTC_Library_PackOutParmType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Err Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Indx - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%Name) - IntKiBuf(Int_Xferred) = ICHAR(InData%Name(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%Units) - IntKiBuf(Int_Xferred) = ICHAR(InData%Units(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%SignM - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Indx + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%Name) + IntKiBuf(Int_Xferred) = ICHAR(InData%Name(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%Units) + IntKiBuf(Int_Xferred) = ICHAR(InData%Units(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%SignM + Int_Xferred = Int_Xferred + 1 END SUBROUTINE NWTC_Library_PackOutParmType SUBROUTINE NWTC_Library_UnPackOutParmType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -759,12 +725,6 @@ SUBROUTINE NWTC_Library_UnPackOutParmType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_UnPackOutParmType' @@ -778,177 +738,20 @@ SUBROUTINE NWTC_Library_UnPackOutParmType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%Indx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%Name) - OutData%Name(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Units) - OutData%Units(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%SignM = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%Indx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%Name) + OutData%Name(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%Units) + OutData%Units(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%SignM = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE NWTC_Library_UnPackOutParmType - SUBROUTINE NWTC_Library_CopyOutParmFFType( SrcOutParmTypeData, DstOutParmTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(OutParmFFType), INTENT(IN) :: SrcOutParmTypeData - TYPE(OutParmFFType), INTENT(INOUT) :: DstOutParmTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_CopyOutParmFFType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstOutParmTypeData%Indx = SrcOutParmTypeData%Indx - DstOutParmTypeData%Name = SrcOutParmTypeData%Name - DstOutParmTypeData%Units = SrcOutParmTypeData%Units - DstOutParmTypeData%SignM = SrcOutParmTypeData%SignM - END SUBROUTINE NWTC_Library_CopyOutParmFFType - - SUBROUTINE NWTC_Library_DestroyOutParmFFType( OutParmTypeData, ErrStat, ErrMsg ) - TYPE(OutParmFFType), INTENT(INOUT) :: OutParmTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_DestroyOutParmFFType' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE NWTC_Library_DestroyOutParmFFType - - SUBROUTINE NWTC_Library_PackOutParmFFType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(OutParmFFType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_PackOutParmFFType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! Indx - Int_BufSz = Int_BufSz + 1*LEN(InData%Name) ! Name - Int_BufSz = Int_BufSz + 1*LEN(InData%Units) ! Units - Int_BufSz = Int_BufSz + 1 ! SignM - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Indx - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%Name) - IntKiBuf(Int_Xferred) = ICHAR(InData%Name(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%Units) - IntKiBuf(Int_Xferred) = ICHAR(InData%Units(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%SignM - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE NWTC_Library_PackOutParmFFType - - SUBROUTINE NWTC_Library_UnPackOutParmFFType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(OutParmFFType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'NWTC_Library_UnPackOutParmFFType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%Indx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%Name) - OutData%Name(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%Units) - OutData%Units(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%SignM = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE NWTC_Library_UnPackOutParmFFType - SUBROUTINE NWTC_Library_CopyFileInfoType( SrcFileInfoTypeData, DstFileInfoTypeData, CtrlCode, ErrStat, ErrMsg ) TYPE(FileInfoType), INTENT(IN) :: SrcFileInfoTypeData TYPE(FileInfoType), INTENT(INOUT) :: DstFileInfoTypeData @@ -1123,10 +926,10 @@ SUBROUTINE NWTC_Library_PackFileInfoType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Er Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumLines - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumFiles - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumLines + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumFiles + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%FileLine) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1137,8 +940,10 @@ SUBROUTINE NWTC_Library_PackFileInfoType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FileLine,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FileLine)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%FileLine))-1 ) = PACK(InData%FileLine,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%FileLine) + DO i1 = LBOUND(InData%FileLine,1), UBOUND(InData%FileLine,1) + IntKiBuf(Int_Xferred) = InData%FileLine(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%FileIndx) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1150,8 +955,10 @@ SUBROUTINE NWTC_Library_PackFileInfoType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FileIndx,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FileIndx)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%FileIndx))-1 ) = PACK(InData%FileIndx,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%FileIndx) + DO i1 = LBOUND(InData%FileIndx,1), UBOUND(InData%FileIndx,1) + IntKiBuf(Int_Xferred) = InData%FileIndx(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%FileList) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1163,12 +970,12 @@ SUBROUTINE NWTC_Library_PackFileInfoType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FileList,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%FileList,1), UBOUND(InData%FileList,1) + DO i1 = LBOUND(InData%FileList,1), UBOUND(InData%FileList,1) DO I = 1, LEN(InData%FileList) IntKiBuf(Int_Xferred) = ICHAR(InData%FileList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%Lines) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1180,12 +987,12 @@ SUBROUTINE NWTC_Library_PackFileInfoType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Lines,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%Lines,1), UBOUND(InData%Lines,1) + DO i1 = LBOUND(InData%Lines,1), UBOUND(InData%Lines,1) DO I = 1, LEN(InData%Lines) IntKiBuf(Int_Xferred) = ICHAR(InData%Lines(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF END SUBROUTINE NWTC_Library_PackFileInfoType @@ -1202,12 +1009,6 @@ SUBROUTINE NWTC_Library_UnPackFileInfoType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1222,10 +1023,10 @@ SUBROUTINE NWTC_Library_UnPackFileInfoType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%NumLines = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumFiles = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NumLines = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumFiles = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FileLine not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1239,15 +1040,10 @@ SUBROUTINE NWTC_Library_UnPackFileInfoType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FileLine.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%FileLine)>0) OutData%FileLine = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%FileLine))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%FileLine) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FileLine,1), UBOUND(OutData%FileLine,1) + OutData%FileLine(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FileIndx not allocated Int_Xferred = Int_Xferred + 1 @@ -1262,15 +1058,10 @@ SUBROUTINE NWTC_Library_UnPackFileInfoType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FileIndx.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%FileIndx)>0) OutData%FileIndx = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%FileIndx))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%FileIndx) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FileIndx,1), UBOUND(OutData%FileIndx,1) + OutData%FileIndx(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FileList not allocated Int_Xferred = Int_Xferred + 1 @@ -1285,19 +1076,12 @@ SUBROUTINE NWTC_Library_UnPackFileInfoType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FileList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%FileList,1), UBOUND(OutData%FileList,1) + DO i1 = LBOUND(OutData%FileList,1), UBOUND(OutData%FileList,1) DO I = 1, LEN(OutData%FileList) OutData%FileList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Lines not allocated Int_Xferred = Int_Xferred + 1 @@ -1312,19 +1096,12 @@ SUBROUTINE NWTC_Library_UnPackFileInfoType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Lines.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%Lines,1), UBOUND(OutData%Lines,1) + DO i1 = LBOUND(OutData%Lines,1), UBOUND(OutData%Lines,1) DO I = 1, LEN(OutData%Lines) OutData%Lines(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF END SUBROUTINE NWTC_Library_UnPackFileInfoType @@ -1422,10 +1199,12 @@ SUBROUTINE NWTC_Library_PackQuaternion( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrS Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%q0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%v))-1 ) = PACK(InData%v,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%v) + ReKiBuf(Re_Xferred) = InData%q0 + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%v,1), UBOUND(InData%v,1) + ReKiBuf(Re_Xferred) = InData%v(i1) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE NWTC_Library_PackQuaternion SUBROUTINE NWTC_Library_UnPackQuaternion( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1441,12 +1220,6 @@ SUBROUTINE NWTC_Library_UnPackQuaternion( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1461,19 +1234,14 @@ SUBROUTINE NWTC_Library_UnPackQuaternion( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%q0 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%q0 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%v,1) i1_u = UBOUND(OutData%v,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%v = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%v))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%v) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%v,1), UBOUND(OutData%v,1) + OutData%v(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE NWTC_Library_UnPackQuaternion END MODULE NWTC_Library_Types diff --git a/modules/nwtc-library/src/NWTC_Num.f90 b/modules/nwtc-library/src/NWTC_Num.f90 index 836fc56e4f..714d05f043 100644 --- a/modules/nwtc-library/src/NWTC_Num.f90 +++ b/modules/nwtc-library/src/NWTC_Num.f90 @@ -55,6 +55,13 @@ MODULE NWTC_Num REAL(ReKi) :: TwoByPi !< 2/Pi REAL(ReKi) :: TwoPi !< 2*Pi + REAL(SiKi) :: Pi_R4 !< Ratio of a circle's circumference to its diameter in 4-byte precision + REAL(R8Ki) :: Pi_R8 !< Ratio of a circle's circumference to its diameter in 8-byte precision + REAL(QuKi) :: Pi_R16 !< Ratio of a circle's circumference to its diameter in 16-byte precision + + REAL(SiKi) :: TwoPi_R4 !< 2*pi in 4-byte precision + REAL(R8Ki) :: TwoPi_R8 !< 2*pi in 8-byte precision + REAL(QuKi) :: TwoPi_R16 !< 2*pi in 16-byte precision !======================================================================= ! Create interfaces for generic routines that use specific routines. @@ -109,10 +116,11 @@ MODULE NWTC_Num MODULE PROCEDURE GetSmllRotAngsR END INTERFACE - !> \copydoc nwtc_num::zero2twopir + !> \copydoc nwtc_num::zero2twopir4 INTERFACE Zero2TwoPi - MODULE PROCEDURE Zero2TwoPiD - MODULE PROCEDURE Zero2TwoPiR + MODULE PROCEDURE Zero2TwoPiR4 + MODULE PROCEDURE Zero2TwoPiR8 + MODULE PROCEDURE Zero2TwoPiR16 END INTERFACE !> \copydoc nwtc_num::twonormr4 @@ -194,57 +202,131 @@ MODULE NWTC_Num MODULE PROCEDURE SkewSymMatR16 END INTERFACE + !> \copydoc nwtc_num::angle_extrapinterp2_r4 + INTERFACE Angles_ExtrapInterp + MODULE PROCEDURE Angles_ExtrapInterp1_R4 + MODULE PROCEDURE Angles_ExtrapInterp1_R8 + MODULE PROCEDURE Angles_ExtrapInterp1_R16 + MODULE PROCEDURE Angles_ExtrapInterp2_R4 + MODULE PROCEDURE Angles_ExtrapInterp2_R8 + MODULE PROCEDURE Angles_ExtrapInterp2_R16 + END INTERFACE + !> \copydoc nwtc_num::addorsub2pi_r4 + INTERFACE AddOrSub2Pi + MODULE PROCEDURE AddOrSub2Pi_R4 + MODULE PROCEDURE AddOrSub2Pi_R8 + MODULE PROCEDURE AddOrSub2Pi_R16 + END INTERFACE + + !> \copydoc nwtc_num::mpi2pi_r4 + INTERFACE MPi2Pi + MODULE PROCEDURE MPi2Pi_R4 + MODULE PROCEDURE MPi2Pi_R8 + MODULE PROCEDURE MPi2Pi_R16 + END INTERFACE + CONTAINS !======================================================================= -!> This routine is used to convert NewAngle to an angle within 2*Pi of -!! OldAngle by adding or subtracting 2*Pi accordingly; it then sets -!! OldAngle equal to NewAngle. This routine is useful for converting +!> This routine is used to convert NewAngle to an angle within Pi of +!! OldAngle by adding or subtracting 2*Pi accordingly. +!! This routine is useful for converting !! angles returned from a call to the ATAN2() FUNCTION into angles that may !! exceed the -Pi to Pi limit of ATAN2(). For example, if the nacelle yaw !! angle was 179deg in the previous time step and the yaw angle increased !! by 2deg in the new time step, we want the new yaw angle returned from a !! call to the ATAN2() FUNCTION to be 181deg instead of -179deg. This !! routine assumes that the angle change between calls is not more than -!! 2*Pi in absolute value. OldAngle should be saved in the calling -!! routine. - SUBROUTINE AddOrSub2Pi ( OldAngle, NewAngle ) +!! Pi in absolute value. +!! Use AddOrSub2Pi (nwtc_num::addorsub2pi) instead of directly calling a specific routine in the generic interface. + SUBROUTINE AddOrSub2Pi_R4 ( OldAngle, NewAngle ) + ! Argument declarations: + + REAL(SiKi), INTENT(IN ) :: OldAngle !< Angle from which NewAngle will be converted to within Pi of, rad. + REAL(SiKi), INTENT(INOUT) :: NewAngle !< Angle to be converted to within 2*Pi of OldAngle, rad. + + + ! Local declarations: + + REAL(SiKi) :: DelAngle ! The difference between OldAngle and NewAngle, rad. + + + + ! Add or subtract 2*Pi in order to convert NewAngle two within Pi of OldAngle: + + + DelAngle = OldAngle - NewAngle + + DO WHILE ( ABS( DelAngle ) > Pi_R4 ) + + NewAngle = NewAngle + SIGN( TwoPi_R4, DelAngle ) + DelAngle = OldAngle - NewAngle + + END DO + + RETURN + END SUBROUTINE AddOrSub2Pi_R4 +!======================================================================= +!> \copydoc nwtc_num::addorsub2pi_r4 + SUBROUTINE AddOrSub2Pi_R8 ( OldAngle, NewAngle ) ! Argument declarations: - REAL(ReKi), INTENT(INOUT) :: OldAngle !< Angle from which NewAngle will be converted to within 2*Pi of, rad. - REAL(ReKi), INTENT(INOUT) :: NewAngle !< Angle to be converted to within 2*Pi of OldAngle, rad. + REAL(R8Ki), INTENT(IN ) :: OldAngle ! Angle from which NewAngle will be converted to within Pi of, rad. + REAL(R8Ki), INTENT(INOUT) :: NewAngle ! Angle to be converted to within Pi of OldAngle, rad. ! Local declarations: - REAL(ReKi) :: DelAngle ! The difference between OldAngle and NewAngle, rad. + REAL(R8Ki) :: DelAngle ! The difference between OldAngle and NewAngle, rad. - ! Add or subtract 2*Pi in order to convert NewAngle two within 2*Pi of - ! OldAngle: + ! Add or subtract 2*Pi in order to convert NewAngle two within Pi of OldAngle: DelAngle = OldAngle - NewAngle - DO WHILE ( ABS( DelAngle ) >= TwoPi ) + DO WHILE ( ABS( DelAngle ) > Pi_R8 ) - NewAngle = NewAngle + SIGN( TwoPi, DelAngle ) + NewAngle = NewAngle + SIGN( TwoPi_R8, DelAngle ) DelAngle = OldAngle - NewAngle END DO + RETURN + END SUBROUTINE AddOrSub2Pi_R8 +!======================================================================= +!> \copydoc nwtc_num::addorsub2pi_r4 + SUBROUTINE AddOrSub2Pi_R16 ( OldAngle, NewAngle ) - ! Set OldAngle to equal NewAngle: + ! Argument declarations: - OldAngle = NewAngle + REAL(QuKi), INTENT(IN ) :: OldAngle ! Angle from which NewAngle will be converted to within 2*Pi of, rad. + REAL(QuKi), INTENT(INOUT) :: NewAngle ! Angle to be converted to within 2*Pi of OldAngle, rad. + ! Local declarations: + + REAL(QuKi) :: DelAngle ! The difference between OldAngle and NewAngle, rad. + + + + ! Add or subtract 2*Pi in order to convert NewAngle two within Pi of OldAngle: + + + DelAngle = OldAngle - NewAngle + + DO WHILE ( ABS( DelAngle ) > Pi_R16 ) + + NewAngle = NewAngle + SIGN( TwoPi_R16, DelAngle ) + DelAngle = OldAngle - NewAngle + + END DO RETURN - END SUBROUTINE AddOrSub2Pi + END SUBROUTINE AddOrSub2Pi_R16 !======================================================================= !> This routine sorts a list of real numbers. It uses the bubble sort algorithm, !! which is only suitable for short lists. @@ -3947,29 +4029,78 @@ END FUNCTION Mean ! ( Ary, AryLen ) !======================================================================= !> This routine is used to convert Angle to an equivalent value !! between \f$-\pi\f$ and \f$pi\f$. - SUBROUTINE MPi2Pi ( Angle ) +!! +!! Use MPi2Pi (nwtc_num::mpi2pi) instead of directly calling a specific routine in the generic interface. + SUBROUTINE MPi2Pi_R4 ( Angle ) + + + ! Argument declarations: + + REAL(SiKi), INTENT(INOUT) :: Angle !< Angle (in radians) to be converted + + + ! Get the angle between 0 and 2Pi. + + Angle = MODULO( Angle, TwoPi_R4 ) + + + ! Get the angle between -Pi and Pi. + + IF ( Angle > Pi_R4 ) THEN + Angle = Angle - TwoPi_R4 + END IF + + + RETURN + END SUBROUTINE MPi2Pi_R4 +!======================================================================= +!> \copydoc nwtc_num::mpi2pi_r4 + SUBROUTINE MPi2Pi_R8 ( Angle ) ! Argument declarations: - REAL(ReKi), INTENT(INOUT) :: Angle !< Angle (in radians) to be converted + REAL(R8Ki), INTENT(INOUT) :: Angle + + + ! Get the angle between 0 and 2Pi. + + Angle = MODULO( Angle, TwoPi_R8 ) + ! Get the angle between -Pi and Pi. + + IF ( Angle > Pi_R8 ) THEN + Angle = Angle - TwoPi_R8 + END IF + + + RETURN + END SUBROUTINE MPi2Pi_R8 +!======================================================================= +!> \copydoc nwtc_num::mpi2pi_r4 + SUBROUTINE MPi2Pi_R16 ( Angle ) + + + ! Argument declarations: + + REAL(QuKi), INTENT(INOUT) :: Angle + ! Get the angle between 0 and 2Pi. - Angle = MODULO( Angle, TwoPi ) + Angle = MODULO( Angle, TwoPi_R16 ) ! Get the angle between -Pi and Pi. - IF ( Angle > Pi ) THEN - Angle = Angle - TwoPi + IF ( Angle > Pi_R16 ) THEN + Angle = Angle - TwoPi_R16 END IF RETURN - END SUBROUTINE MPi2Pi + END SUBROUTINE MPi2Pi_R16 !======================================================================= !> This function takes an angle in radians and converts it to !! an angle in degrees in the range [-180,180] @@ -4066,7 +4197,7 @@ END FUNCTION OuterProductR16 !! a change in log map parameters. SUBROUTINE PerturbOrientationMatrix( Orientation, Perturbation, AngleDim ) REAL(R8Ki), INTENT(INOUT) :: Orientation(3,3) - REAL(R8Ki), INTENT(IN) :: Perturbation + REAL(R8Ki), INTENT(IN) :: Perturbation ! angle (radians) of the perturbation INTEGER, INTENT(IN) :: AngleDim ! Local variables @@ -4879,7 +5010,7 @@ END SUBROUTINE RombergInt !======================================================================= !> This routine displays a message that gives that status of the simulation and the predicted end time of day. !! It is intended to be used with SimStatus (nwtc_num::simstatus) and SimStatus_FirstTime (nwtc_num::simstatus_firsttime). - SUBROUTINE RunTimes( StrtTime, UsrTime1, SimStrtTime, UsrTime2, ZTime, UsrTime_out, DescStrIn ) + SUBROUTINE RunTimes( StrtTime, UsrTime1, SimStrtTime, UsrTime2, ZTime, UnSum, UsrTime_out, DescStrIn ) IMPLICIT NONE @@ -4890,6 +5021,7 @@ SUBROUTINE RunTimes( StrtTime, UsrTime1, SimStrtTime, UsrTime2, ZTime, UsrTime_o REAL(ReKi), INTENT(IN) :: UsrTime1 !< User CPU time for simulation initialization. REAL(ReKi), INTENT(IN) :: UsrTime2 !< User CPU time for simulation (without intialization) REAL(DbKi), INTENT(IN) :: ZTime !< The final simulation time (not necessarially TMax) + INTEGER(IntKi), INTENT(IN), OPTIONAL:: UnSum !< optional unit number of file. If present and > 0, REAL(ReKi), INTENT(OUT),OPTIONAL:: UsrTime_out !< User CPU time for entire run - optional value returned to calling routine CHARACTER(*), INTENT(IN), OPTIONAL :: DescStrIn !< optional additional string to print for SimStatus @@ -4965,6 +5097,19 @@ SUBROUTINE RunTimes( StrtTime, UsrTime1, SimStrtTime, UsrTime2, ZTime, UsrTime_o CALL WrScr ( ' Simulated Time: '//TRIM( Num2LStr( Factor*REAL( ZTime ) ) )//TRIM( TimePer ) ) CALL WrScr ( ' Time Ratio (Sim/CPU): '//TRIM( Num2LStr( TRatio ) ) ) + IF (PRESENT(UnSum)) THEN + IF (UnSum>0) THEN + WRITE( UnSum, '(//)' ) + WRITE( UnSum, '(A)') ' Total Real Time: '//TRIM( Num2LStr( Factor*ClckTime ) )//TRIM( TimePer ) + WRITE( UnSum, '(A)') ' Total CPU Time: '//TRIM( Num2LStr( Factor*UsrTime ) )//TRIM( TimePer ) + WRITE( UnSum, '(A)') ' Simulation CPU Time: '//TRIM( Num2LStr( Factor*UsrTimeSim ) )//TRIM( TimePer ) + WRITE( UnSum, '(A)') ' Simulated Time: '//TRIM( Num2LStr( Factor*REAL( ZTime ) ) )//TRIM( TimePer ) + WRITE( UnSum, '(A)') ' Time Ratio (Sim/CPU): '//TRIM( Num2LStr( TRatio ) ) + END IF + END IF + + + ENDIF IF (PRESENT(UsrTime_out)) UsrTime_out = UsrTime @@ -4975,8 +5120,8 @@ FUNCTION GetClockTime(StartClockTime, EndClockTime) ! return the number of seconds between StartClockTime and EndClockTime REAL :: GetClockTime ! Elapsed clock time for the simulation phase of the run. - INTEGER , INTENT(IN) :: StartClockTime (8) ! Start time of simulation (after initialization) - INTEGER , INTENT(IN) :: EndClockTime (8) ! Start time of simulation (after initialization) + INTEGER , INTENT(IN) :: StartClockTime (8) ! Start time of simulation (after initialization) + INTEGER , INTENT(IN) :: EndClockTime (8) ! Start time of simulation (after initialization) !bjj: This calculation will be wrong at certain times (e.g. if it's near midnight on the last day of the month), but to my knowledge, no one has complained... GetClockTime = 0.001*( EndClockTime(8) - StartClockTime(8) ) & ! Is the milliseconds of the second (range 0 to 999) - local time @@ -5054,7 +5199,14 @@ SUBROUTINE SetConstants( ) TwoPi = 2.0_ReKi*Pi Inv2Pi = 0.5_ReKi/Pi ! 1.0/TwoPi + Pi_R4 = ACOS( -1.0_SiKi ) + Pi_R8 = ACOS( -1.0_R8Ki ) + Pi_R16 = ACOS( -1.0_QuKi ) + TwoPi_R4 = Pi_R4 *2.0_SiKi + TwoPi_R8 = Pi_R8 *2.0_R8Ki + TwoPi_R16 = Pi_R16*2.0_QuKi + ! IEEE constants: CALL Set_IEEE_Constants( NaN_D, Inf_D, NaN, Inf ) @@ -5193,7 +5345,7 @@ SUBROUTINE SimStatus( PrevSimTime, PrevClockTime, ZTime, TMax, DescStrIn ) PrevSimTime = ZTime RETURN - END SUBROUTINE SimStatus + END SUBROUTINE SimStatus !======================================================================= !> This routine computes the 3x3 transformation matrix, \f$TransMat\f$, !! to a coordinate system \f$x\f$ (with orthogonal axes \f$x_1, x_2, x_3\f$) @@ -5620,7 +5772,12 @@ SUBROUTINE SortUnion ( Ary1, N1, Ary2, N2, Ary, N ) END SUBROUTINE SortUnion ! ( Ary1, N1, Ary2, N2, Ary, N ) !======================================================================= !> This routine calculates the standard deviation of a population contained in Ary. - FUNCTION StdDevFn ( Ary, AryLen, Mean ) +!! +!! This can be calculated as either\n +!! \f$ \sqrt{ \frac{\sum_{i=1}^N \left(x_i -\bar{x}\right)^2 }{N-1} } \f$ \n +!! or \n +!! \f$ \sqrt{ \frac{\sum_{i=1}^N \left(x_i -\bar{x}\right)^2 }{N} } \f$ if `UseN` is true \n + FUNCTION StdDevFn ( Ary, AryLen, Mean, UseN ) ! Function declaration. @@ -5633,6 +5790,7 @@ FUNCTION StdDevFn ( Ary, AryLen, Mean ) REAL(ReKi), INTENT(IN) :: Ary (AryLen) !< Input array. REAL(ReKi), INTENT(IN) :: Mean !< The previously calculated mean of the array. + LOGICAL, OPTIONAL, INTENT(IN) :: UseN !< Use `N` insted of `N-1` in denomenator ! Local declarations. @@ -5640,8 +5798,17 @@ FUNCTION StdDevFn ( Ary, AryLen, Mean ) REAL(DbKi) :: Sum ! A temporary sum. INTEGER :: I ! The index into the array. + INTEGER :: Denom ! Denominator - + IF(PRESENT(UseN)) THEN + IF (UseN) THEN + Denom = AryLen + ELSE + Denom = AryLen-1 + ENDIF + ELSE + Denom = AryLen-1 + ENDIF Sum = 0.0_DbKi @@ -5649,7 +5816,7 @@ FUNCTION StdDevFn ( Ary, AryLen, Mean ) Sum = Sum + ( Ary(I) - Mean )**2 END DO ! I - StdDevFn = SQRT( Sum/( AryLen - 1 ) ) + StdDevFn = SQRT( Sum/( Denom ) ) RETURN @@ -5733,6 +5900,7 @@ FUNCTION SkewSymMatR16 ( x ) RESULT(M) RETURN END FUNCTION SkewSymMatR16 + !======================================================================= !> This routine takes an array of time values such as that returned from !! CALL DATE_AND_TIME ( Values=TimeAry ) @@ -5807,7 +5975,6 @@ FUNCTION traceR16(A) end do END FUNCTION traceR16 - !======================================================================= !> This function returns the \f$l_2\f$ (Euclidian) norm of a vector, !! \f$v = \left(v_1, v_2, \ldots ,v_n\right)\f$. The \f$l_2\f$-norm is defined as @@ -5858,30 +6025,58 @@ FUNCTION TwoNormR16(v) !> This routine is used to convert Angle to an equivalent value !! in the range \f$[0, 2\pi)\f$. \n !! Use Zero2TwoPi (nwtc_num::zero2twopi) instead of directly calling a specific routine in the generic interface. - SUBROUTINE Zero2TwoPiR ( Angle ) + SUBROUTINE Zero2TwoPiR4 ( Angle ) ! Argument declarations: - REAL(ReKi), INTENT(INOUT) :: Angle !< angle that is input and converted to equivalent in range \f$[0, 2\pi)\f$ + REAL(SiKi), INTENT(INOUT) :: Angle !< angle that is input and converted to equivalent in range \f$[0, 2\pi)\f$ ! Get the angle between 0 and 2Pi. - Angle = MODULO( Angle, TwoPi ) + Angle = MODULO( Angle, TwoPi_R4 ) ! Check numerical case where Angle == 2Pi. - IF ( Angle == TwoPi ) THEN + IF ( Angle == TwoPi_R4 ) THEN Angle = 0.0_ReKi END IF RETURN - END SUBROUTINE Zero2TwoPiR + END SUBROUTINE Zero2TwoPiR4 +!======================================================================= +!> \copydoc nwtc_num::zero2twopir4 + SUBROUTINE Zero2TwoPiR8 ( Angle ) + + ! This routine is used to convert Angle to an equivalent value + ! in the range [0, 2*pi). + + + ! Argument declarations: + + REAL(R8Ki), INTENT(INOUT) :: Angle + + + + ! Get the angle between 0 and 2Pi. + + Angle = MODULO( Angle, TwoPi_R8 ) + + + ! Check numerical case where Angle == 2Pi. + + IF ( Angle == TwoPi_R8 ) THEN + Angle = 0.0_DbKi + END IF + + + RETURN + END SUBROUTINE Zero2TwoPiR8 !======================================================================= -!> \copydoc nwtc_num::zero2twopir - SUBROUTINE Zero2TwoPiD ( Angle ) +!> \copydoc nwtc_num::zero2twopir4 + SUBROUTINE Zero2TwoPiR16 ( Angle ) ! This routine is used to convert Angle to an equivalent value ! in the range [0, 2*pi). @@ -5889,23 +6084,340 @@ SUBROUTINE Zero2TwoPiD ( Angle ) ! Argument declarations: - REAL(DbKi), INTENT(INOUT) :: Angle + REAL(QuKi), INTENT(INOUT) :: Angle ! Get the angle between 0 and 2Pi. - Angle = MODULO( Angle, TwoPi_D ) + Angle = MODULO( Angle, TwoPi_R16 ) ! Check numerical case where Angle == 2Pi. - IF ( Angle == TwoPi_D ) THEN + IF ( Angle == TwoPi_R16 ) THEN Angle = 0.0_DbKi END IF RETURN - END SUBROUTINE Zero2TwoPiD + END SUBROUTINE Zero2TwoPiR16 +!======================================================================= + !< This routine extrapolates or interpolates between angles + SUBROUTINE Angles_ExtrapInterp1_R4(Angle1, Angle2, tin, Angle_out, tin_out ) + REAL(SiKi), INTENT(IN ) :: Angle1 !< Angle at t1 > t2 + REAL(SiKi), INTENT(IN ) :: Angle2 !< Angle at t2 + REAL(DbKi), INTENT(IN ) :: tin(:) !< Times associated with the inputs + REAL(SiKi), INTENT(INOUT) :: Angle_out !< Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out !< time to be extrap/interp'd to + + ! local variables + INTEGER(IntKi), parameter :: order = 1 ! order of polynomial fit (max 2) + REAL(DbKi) :: t(SIZE(tin)) ! Times associated with the inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + + REAL(SiKi) :: Angle2_mod + + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + ! ! some error checking: + ! + ! if ( size(t) .ne. order+1) then + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp1: size(t) must equal 2.' + ! RETURN + ! end if + ! + !IF ( EqualRealNos( t(1), t(2) ) ) THEN + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp1: t(1) must not equal t(2) to avoid a division-by-zero error.' + ! RETURN + !END IF + + Angle2_mod = Angle2 + call AddOrSub2Pi( Angle1, Angle2_mod ) + + Angle_out = Angle1 + (Angle2_mod - Angle1) * t_out / t(2) + +! call Zero2TwoPi(Angle_out) +! call MPi2Pi(Angle_out) + + END SUBROUTINE Angles_ExtrapInterp1_R4 +!======================================================================= + !< This routine extrapolates or interpolates between angles + SUBROUTINE Angles_ExtrapInterp1_R8(Angle1, Angle2, tin, Angle_out, tin_out) + REAL(R8Ki), INTENT(IN ) :: Angle1 !< Angle at t1 > t2 + REAL(R8Ki), INTENT(IN ) :: Angle2 !< Angle at t2 + REAL(DbKi), INTENT(IN ) :: tin(:) !< Times associated with the inputs + REAL(R8Ki), INTENT(INOUT) :: Angle_out !< Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out !< time to be extrap/interp'd to + + ! local variables + INTEGER(IntKi), parameter :: order = 1 ! order of polynomial fit (max 2) + REAL(DbKi) :: t(SIZE(tin)) ! Times associated with the inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + + REAL(R8Ki) :: Angle2_mod + + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + ! ! some error checking: + ! + ! if ( size(t) .ne. order+1) then + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp1: size(t) must equal 2.' + ! RETURN + ! end if + ! + !IF ( EqualRealNos( t(1), t(2) ) ) THEN + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp1: t(1) must not equal t(2) to avoid a division-by-zero error.' + ! RETURN + !END IF + + Angle2_mod = Angle2 + call AddOrSub2Pi( Angle1, Angle2_mod ) + + Angle_out = Angle1 + (Angle2_mod - Angle1) * t_out / t(2) +! call Zero2TwoPi(Angle_out) +! call MPi2Pi(Angle_out) + + END SUBROUTINE Angles_ExtrapInterp1_R8 +!======================================================================= + !< This routine extrapolates or interpolates between angles + SUBROUTINE Angles_ExtrapInterp1_R16(Angle1, Angle2, tin, Angle_out, tin_out) + REAL(QuKi), INTENT(IN ) :: Angle1 !< Angle at t1 > t2 + REAL(QuKi), INTENT(IN ) :: Angle2 !< Angle at t2 + REAL(DbKi), INTENT(IN ) :: tin(:) !< Times associated with the inputs + REAL(QuKi), INTENT(INOUT) :: Angle_out !< Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out !< time to be extrap/interp'd to + + ! local variables + INTEGER(IntKi), parameter :: order = 1 ! order of polynomial fit (max 2) + REAL(DbKi) :: t(SIZE(tin)) ! Times associated with the inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + + REAL(QuKi) :: Angle2_mod + + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + ! ! some error checking: + ! + ! if ( size(t) .ne. order+1) then + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp1: size(t) must equal 2.' + ! RETURN + ! end if + ! + !IF ( EqualRealNos( t(1), t(2) ) ) THEN + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp1: t(1) must not equal t(2) to avoid a division-by-zero error.' + ! RETURN + !END IF + + Angle2_mod = Angle2 + call AddOrSub2Pi( Angle1, Angle2_mod ) + + Angle_out = Angle1 + (Angle2_mod - Angle1) * t_out / t(2) +! call Zero2TwoPi(Angle_out) +! call MPi2Pi(Angle_out) + + END SUBROUTINE Angles_ExtrapInterp1_R16 +!======================================================================= + !< This routine extrapolates or interpolates between angles + SUBROUTINE Angles_ExtrapInterp2_R4(Angle1, Angle2, Angle3, tin, Angle_out, tin_out ) + REAL(SiKi), INTENT(IN ) :: Angle1 !< Angle at t1 > t2 > t3 + REAL(SiKi), INTENT(IN ) :: Angle2 !< Angle at t2 > t3 + REAL(SiKi), INTENT(IN ) :: Angle3 !< Angle at t3 + REAL(DbKi), INTENT(IN ) :: tin(:) !< Times associated with the inputs + REAL(SiKi), INTENT(INOUT) :: Angle_out !< Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out !< time to be extrap/interp'd to + + ! local variables + INTEGER(IntKi), parameter :: order = 2 ! order of polynomial fit (max 2) + REAL(DbKi) :: t(SIZE(tin)) ! Times associated with the inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + + REAL(DbKi) :: scaleFactor ! temporary for extrapolation/interpolation + REAL(SiKi) :: Angle2_mod + REAL(SiKi) :: Angle3_mod + + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + ! ! some error checking: + ! + !if ( size(t) .ne. order+1) then + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp2: size(t) must equal 3.' + ! RETURN + !end if + ! + !IF ( EqualRealNos( t(1), t(2) ) ) THEN + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp2: t(1) must not equal t(2) to avoid a division-by-zero error.' + ! RETURN + !END IF + !IF ( EqualRealNos( t(2), t(3) ) ) THEN + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp2: t(2) must not equal t(3) to avoid a division-by-zero error.' + ! RETURN + !END IF + !IF ( EqualRealNos( t(1), t(3) ) ) THEN + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp2: t(1) must not equal t(3) to avoid a division-by-zero error.' + ! RETURN + !END IF + + Angle2_mod = Angle2 + Angle3_mod = Angle3 + call AddOrSub2Pi( Angle1, Angle2_mod ) + call AddOrSub2Pi( Angle2_mod, Angle3_mod ) + + scaleFactor = t_out / ( t(2) * t(3) * (t(2) - t(3)) ) + + Angle_out = Angle1 & + + ( t(3)**2 * (Angle1 - Angle2_mod) + t(2)**2*(-Angle1 + Angle3_mod) ) * scaleFactor & + + ( (t(2)-t(3))*Angle1 + t(3)*Angle2_mod - t(2)*Angle3_mod ) *scaleFactor * t_out + +! call Zero2TwoPi(Angle_out) +! call MPi2Pi(Angle_out) + + END SUBROUTINE Angles_ExtrapInterp2_R4 +!======================================================================= + !< This routine extrapolates or interpolates between angles + SUBROUTINE Angles_ExtrapInterp2_R8(Angle1, Angle2, Angle3, tin, Angle_out, tin_out) + REAL(R8Ki), INTENT(IN ) :: Angle1 !< Angle at t1 > t2 > t3 + REAL(R8Ki), INTENT(IN ) :: Angle2 !< Angle at t2 > t3 + REAL(R8Ki), INTENT(IN ) :: Angle3 !< Angle at t3 + REAL(DbKi), INTENT(IN ) :: tin(:) !< Times associated with the inputs + REAL(R8Ki), INTENT(INOUT) :: Angle_out !< Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out !< time to be extrap/interp'd to + + ! local variables + INTEGER(IntKi), parameter :: order = 2 ! order of polynomial fit (max 2) + REAL(DbKi) :: t(SIZE(tin)) ! Times associated with the inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + + REAL(DbKi) :: scaleFactor ! temporary for extrapolation/interpolation + REAL(R8Ki) :: Angle2_mod + REAL(R8Ki) :: Angle3_mod + + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + ! some error checking: + + !if ( size(t) .ne. order+1) then + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp2: size(t) must equal 3.' + ! RETURN + !end if + ! + !IF ( EqualRealNos( t(1), t(2) ) ) THEN + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp2: t(1) must not equal t(2) to avoid a division-by-zero error.' + ! RETURN + !END IF + !IF ( EqualRealNos( t(2), t(3) ) ) THEN + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp2: t(2) must not equal t(3) to avoid a division-by-zero error.' + ! RETURN + !END IF + !IF ( EqualRealNos( t(1), t(3) ) ) THEN + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp2: t(1) must not equal t(3) to avoid a division-by-zero error.' + ! RETURN + !END IF + + Angle2_mod = Angle2 + Angle3_mod = Angle3 + call AddOrSub2Pi( Angle1, Angle2_mod ) + call AddOrSub2Pi( Angle2_mod, Angle3_mod ) + + scaleFactor = t_out / ( t(2) * t(3) * (t(2) - t(3)) ) + + Angle_out = Angle1 & + + ( t(3)**2 * (Angle1 - Angle2_mod) + t(2)**2*(-Angle1 + Angle3_mod) ) * scaleFactor & + + ( (t(2)-t(3))*Angle1 + t(3)*Angle2_mod - t(2)*Angle3_mod ) *scaleFactor * t_out +! call Zero2TwoPi(Angle_out) +! call MPi2Pi(Angle_out) + + END SUBROUTINE Angles_ExtrapInterp2_R8 +!======================================================================= + !< This routine extrapolates or interpolates between angles + SUBROUTINE Angles_ExtrapInterp2_R16(Angle1, Angle2, Angle3, tin, Angle_out, tin_out ) + REAL(QuKi), INTENT(IN ) :: Angle1 !< Angle at t1 > t2 > t3 + REAL(QuKi), INTENT(IN ) :: Angle2 !< Angle at t2 > t3 + REAL(QuKi), INTENT(IN ) :: Angle3 !< Angle at t3 + REAL(DbKi), INTENT(IN ) :: tin(:) !< Times associated with the inputs + REAL(QuKi), INTENT(INOUT) :: Angle_out !< Input at tin_out + REAL(DbKi), INTENT(IN ) :: tin_out !< time to be extrap/interp'd to + + ! local variables + INTEGER(IntKi), parameter :: order = 2 ! order of polynomial fit (max 2) + REAL(DbKi) :: t(SIZE(tin)) ! Times associated with the inputs + REAL(DbKi) :: t_out ! Time to which to be extrap/interpd + + REAL(DbKi) :: scaleFactor ! temporary for extrapolation/interpolation + REAL(QuKi) :: Angle2_mod + REAL(QuKi) :: Angle3_mod + + ! we'll subtract a constant from the times to resolve some + ! numerical issues when t gets large (and to simplify the equations) + t = tin - tin(1) + t_out = tin_out - tin(1) + + ! some error checking: + + !if ( size(t) .ne. order+1) then + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp2: size(t) must equal 3.' + ! RETURN + !end if + ! + !IF ( EqualRealNos( t(1), t(2) ) ) THEN + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp2: t(1) must not equal t(2) to avoid a division-by-zero error.' + ! RETURN + !END IF + !IF ( EqualRealNos( t(2), t(3) ) ) THEN + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp2: t(2) must not equal t(3) to avoid a division-by-zero error.' + ! RETURN + !END IF + !IF ( EqualRealNos( t(1), t(3) ) ) THEN + ! ErrStat = ErrID_Fatal + ! ErrMsg = 'Angles_ExtrapInterp2: t(1) must not equal t(3) to avoid a division-by-zero error.' + ! RETURN + !END IF + + Angle2_mod = Angle2 + Angle3_mod = Angle3 + call AddOrSub2Pi( Angle1, Angle2_mod ) + call AddOrSub2Pi( Angle2_mod, Angle3_mod ) + + scaleFactor = t_out / ( t(2) * t(3) * (t(2) - t(3)) ) + + Angle_out = Angle1 & + + ( t(3)**2 * (Angle1 - Angle2_mod) + t(2)**2*(-Angle1 + Angle3_mod) ) * scaleFactor & + + ( (t(2)-t(3))*Angle1 + t(3)*Angle2_mod - t(2)*Angle3_mod ) *scaleFactor * t_out +! call Zero2TwoPi(Angle_out) +! call MPi2Pi(Angle_out) + + END SUBROUTINE Angles_ExtrapInterp2_R16 !======================================================================= END MODULE NWTC_Num diff --git a/modules/nwtc-library/src/NetLib/lapack/NWTC_LAPACK.f90 b/modules/nwtc-library/src/NetLib/lapack/NWTC_LAPACK.f90 index f82fff275c..99cdd7a088 100644 --- a/modules/nwtc-library/src/NetLib/lapack/NWTC_LAPACK.f90 +++ b/modules/nwtc-library/src/NetLib/lapack/NWTC_LAPACK.f90 @@ -99,7 +99,54 @@ MODULE NWTC_LAPACK MODULE PROCEDURE LAPACK_sgesvd END INTERFACE + +!> straight-up lapack routines (from ExtPtfm_MCKF): + INTERFACE LAPACK_COPY + SUBROUTINE DCOPY(N,DX,INCX,DY,INCY) + USE Precision, only: R8Ki + INTEGER :: INCX,INCY,N + real(R8Ki) :: DX(*),DY(*) + ENDSUBROUTINE + SUBROUTINE SCOPY(N,X,INCX,Y,INCY) + USE Precision, only: SiKi + INTEGER :: INCX,INCY,N + real(SiKi) :: X(*),Y(*) + ENDSUBROUTINE + END INTERFACE + + INTERFACE LAPACK_GEMV + SUBROUTINE DGEMV(TRANS,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) + USE Precision, only: R8Ki + real(R8Ki) :: ALPHA,BETA + integer :: INCX,INCY,LDA,M,N + character :: TRANS + real(R8Ki) :: A(LDA,*),X(*),Y(*) + ENDSUBROUTINE + SUBROUTINE SGEMV(TRANS,M,N,ALPHA,A,LDA,X,INCX,BETA,Y,INCY) + USE Precision, only: SiKi + real(SiKi) :: ALPHA,BETA + integer :: INCX,INCY,LDA,M,N + character :: TRANS + real(SiKi) :: A(LDA,*),X(*),Y(*) + ENDSUBROUTINE + END INTERFACE LAPACK_GEMV + + INTERFACE LAPACK_AXPY + SUBROUTINE DAXPY(N,DA,DX,INCX,DY,INCY) + USE Precision, only: R8Ki + real(R8Ki) :: DA + integer :: INCX,INCY,N + real(R8Ki) :: DX(*),DY(*) + ENDSUBROUTINE + SUBROUTINE SAXPY(N,A,X,INCX,Y,INCY) + USE Precision, only: SiKi + real(SiKi) :: A + integer :: INCX,INCY,N + real(SiKi) :: X(*),Y(*) + ENDSUBROUTINE + END INTERFACE + CONTAINS !======================================================================= diff --git a/modules/nwtc-library/src/Registry_NWTC_Library.txt b/modules/nwtc-library/src/Registry_NWTC_Library.txt index b9eda5344b..a723a870d8 100644 --- a/modules/nwtc-library/src/Registry_NWTC_Library.txt +++ b/modules/nwtc-library/src/Registry_NWTC_Library.txt @@ -24,11 +24,6 @@ usefrom ^ ^ CHARACTER(ChanLen) Name usefrom ^ ^ CHARACTER(ChanLen) Units usefrom ^ ^ IntKi SignM -usefrom NWTC_Library OutParmFFType IntKi Indx -usefrom ^ ^ CHARACTER(ChanLenFF) Name -usefrom ^ ^ CHARACTER(ChanLenFF) Units -usefrom ^ ^ IntKi SignM - usefrom NWTC_Library FileInfoType IntKi NumLines usefrom ^ ^ IntKi NumFiles usefrom ^ ^ IntKi FileLine {:} @@ -64,8 +59,8 @@ usefrom ^ ^ MeshType Augmented_L usefrom ^ ^ MeshType Lumped_Points_Src - usefrom ^ ^ INTEGER LoadLn2_A_Mat_Piv {:} usefrom ^ ^ R8Ki DisplacedPosition {:}{:}{:} -usefrom ^ ^ R8Ki LoadLn2_F {:}{:} usefrom ^ ^ R8Ki LoadLn2_A_Mat {:}{:} +usefrom ^ ^ R8Ki LoadLn2_F {:}{:} usefrom ^ ^ R8Ki LoadLn2_M {:}{:} usefrom ^ ^ MeshMapLinearizationType dM diff --git a/modules/nwtc-library/src/Registry_NWTC_Library_typedef_mesh.txt b/modules/nwtc-library/src/Registry_NWTC_Library_typedef_mesh.txt index 8dd68da34d..bb2096f1fd 100644 --- a/modules/nwtc-library/src/Registry_NWTC_Library_typedef_mesh.txt +++ b/modules/nwtc-library/src/Registry_NWTC_Library_typedef_mesh.txt @@ -27,13 +27,13 @@ typedef ^ ^ R8Ki M_f { typedef NWTC_Library MeshMapType MapType MapLoads {:} - - "mapping data structure for loads on the mesh" typedef ^ ^ MapType MapMotions {:} - - "mapping data structure for motions and/or scalars on the mesh" -typedef ^ ^ MapType MapSrcToAugmt {:} - - "for source line2 loads, we map between source and an augmented source mesh, then betwee augmented source and destination" +typedef ^ ^ MapType MapSrcToAugmt {:} - - "for source line2 loads, we map between source and an augmented source mesh, then between augmented source and destination" typedef ^ ^ MeshType Augmented_Ln2_Src - - - "temporary mesh for storing augmented line2 source values" typedef ^ ^ MeshType Lumped_Points_Src - - - "temporary mesh for lumping lines to points, stored here for efficiency" -typedef ^ ^ INTEGER LoadLn2_A_Mat_Piv {:} - - "The pivot values for the factorizatioin of LoadLn2_A_Mat" +typedef ^ ^ INTEGER LoadLn2_A_Mat_Piv {:} - - "The pivot values for the factorization of LoadLn2_A_Mat" typedef ^ ^ R8Ki DisplacedPosition {:}{:}{:} - - "couple_arm +Scr%Disp - Dest%Disp for each mapped node (stored here for efficiency)" -typedef ^ ^ R8Ki LoadLn2_F {:}{:} - - "The 6-by-6 matrix that makes up the diagonal of the [A 0; B A] matrix in the point-to-line load mapping" typedef ^ ^ R8Ki LoadLn2_A_Mat {:}{:} - - "The 3-components of the forces for each node of an element in the point-to-line load mapping (for each element)" +typedef ^ ^ R8Ki LoadLn2_F {:}{:} - - "The 6-by-6 matrix that makes up the diagonal of the [A 0; B A] matrix in the point-to-line load mapping" typedef ^ ^ R8Ki LoadLn2_M {:}{:} - - "The 3-components of the moments for each node of an element in the point-to-line load mapping (for each element)" typedef ^ ^ MeshMapLinearizationType dM #typedef ^ ^ MeshType Lumped_Points_Dest - - - "temporary mesh for debugging the lumped values in the line2-to-line2" diff --git a/modules/nwtc-library/src/Registry_NWTC_Library_typedef_nomesh.txt b/modules/nwtc-library/src/Registry_NWTC_Library_typedef_nomesh.txt index d0c0abe726..b69bd3831b 100644 --- a/modules/nwtc-library/src/Registry_NWTC_Library_typedef_nomesh.txt +++ b/modules/nwtc-library/src/Registry_NWTC_Library_typedef_nomesh.txt @@ -24,10 +24,6 @@ typedef ^ ^ CHARACTER(ChanLen) Name - - typedef ^ ^ CHARACTER(ChanLen) Units - - - "Units this channel is specified in" typedef ^ ^ IntKi SignM - - - "Multiplier for output channel; usually -1 (minus) or 0 (invalid channel)" -typedef NWTC_Library OutParmFFType IntKi Indx - - - "An index into AllOuts array where this channel is computed/stored" -typedef ^ ^ CHARACTER(ChanLenFF) Name - - - "Name of the output channel" -typedef ^ ^ CHARACTER(ChanLenFF) Units - - - "Units this channel is specified in" -typedef ^ ^ IntKi SignM - - - "Multiplier for output channel; usually -1 (minus) or 0 (invalid channel)" typedef NWTC_Library FileInfoType IntKi NumLines typedef ^ ^ IntKi NumFiles diff --git a/modules/openfast-library/src/FAST_Library.f90 b/modules/openfast-library/src/FAST_Library.f90 index c1d1aa099c..28a426e4af 100644 --- a/modules/openfast-library/src/FAST_Library.f90 +++ b/modules/openfast-library/src/FAST_Library.f90 @@ -21,7 +21,7 @@ MODULE FAST_Data REAL(DbKi), PARAMETER :: t_initial = 0.0_DbKi ! Initial time INTEGER(IntKi) :: NumTurbines INTEGER, PARAMETER :: IntfStrLen = 1025 ! length of strings through the C interface - INTEGER(IntKi), PARAMETER :: MAXOUTPUTS = 1000 ! Maximum number of outputs + INTEGER(IntKi), PARAMETER :: MAXOUTPUTS = 4000 ! Maximum number of outputs INTEGER(IntKi), PARAMETER :: MAXInitINPUTS = 10 ! Maximum number of initialization values from Simulink INTEGER(IntKi), PARAMETER :: NumFixedInputs = 8 diff --git a/modules/openfast-library/src/FAST_Library.h b/modules/openfast-library/src/FAST_Library.h index 8ccb055912..2d1e7833ce 100644 --- a/modules/openfast-library/src/FAST_Library.h +++ b/modules/openfast-library/src/FAST_Library.h @@ -43,7 +43,7 @@ EXTERNAL_ROUTINE void FAST_CreateCheckpoint(int * iTurb, const char *CheckpointR // make sure these parameters match with FAST_Library.f90 #define MAXIMUM_BLADES 3 -#define MAXIMUM_OUTPUTS 1000 +#define MAXIMUM_OUTPUTS 4000 #define CHANNEL_LENGTH 10 #define MAXInitINPUTS 10 diff --git a/modules/openfast-library/src/FAST_Lin.f90 b/modules/openfast-library/src/FAST_Lin.f90 index 763f28e265..d31d3c4070 100644 --- a/modules/openfast-library/src/FAST_Lin.f90 +++ b/modules/openfast-library/src/FAST_Lin.f90 @@ -30,13 +30,14 @@ MODULE FAST_Linear !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !---------------------------------------------------------------------------------------------------------------------------------- !> Routine that initializes some variables for linearization. -SUBROUTINE Init_Lin(p_FAST, y_FAST, m_FAST, AD, NumBl, ErrStat, ErrMsg) +SUBROUTINE Init_Lin(p_FAST, y_FAST, m_FAST, AD, ED, NumBl, ErrStat, ErrMsg) TYPE(FAST_ParameterType), INTENT(INOUT) :: p_FAST !< Parameters for the glue code TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables TYPE(AeroDyn_Data), INTENT(IN ) :: AD !< AeroDyn data - INTEGER(IntKi), INTENT(IN) :: NumBl !< Number of blades (for index into ED input array) + TYPE(ElastoDyn_Data), INTENT(IN ) :: ED !< ElastoDyn data + INTEGER(IntKi), INTENT(IN ) :: NumBl !< Number of blades (for index into ED input array) INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None @@ -44,6 +45,7 @@ SUBROUTINE Init_Lin(p_FAST, y_FAST, m_FAST, AD, NumBl, ErrStat, ErrMsg) INTEGER(IntKi) :: i, j, k ! loop/temp variables INTEGER(IntKi) :: ThisModule ! Module ID # INTEGER(IntKi) :: NumInstances ! Number of instances of each module + INTEGER(IntKi) :: NumStates ! Number of states required for the x_eig arrays INTEGER(IntKi) :: i_u ! loop/temp variables INTEGER(IntKi) :: i_y, i_x ! loop/temp variables @@ -117,6 +119,7 @@ SUBROUTINE Init_Lin(p_FAST, y_FAST, m_FAST, AD, NumBl, ErrStat, ErrMsg) ! determine total number of inputs/outputs/contStates: !..................... y_FAST%Lin%Glue%SizeLin = 0 + y_FAST%Lin%Glue%NumOutputs = 0 do i = 1,p_FAST%Lin_NumMods ThisModule = p_FAST%Lin_ModOrder( i ) @@ -128,6 +131,8 @@ SUBROUTINE Init_Lin(p_FAST, y_FAST, m_FAST, AD, NumBl, ErrStat, ErrMsg) if (allocated(y_FAST%Lin%Modules(ThisModule)%Instance(k)%Names_x)) y_FAST%Lin%Modules(ThisModule)%Instance(k)%SizeLin(LIN_ContSTATE_COL) = size(y_FAST%Lin%Modules(ThisModule)%Instance(k)%Names_x) y_FAST%Lin%Glue%SizeLin = y_FAST%Lin%Glue%SizeLin + y_FAST%Lin%Modules(ThisModule)%Instance(k)%SizeLin ! total number of inputs, outputs, and continuous states + + y_FAST%Lin%Glue%NumOutputs = y_FAST%Lin%Glue%NumOutputs + y_FAST%Lin%Modules(ThisModule)%Instance(k)%NumOutputs ! total number of WriteOutputs end do end do @@ -137,6 +142,7 @@ SUBROUTINE Init_Lin(p_FAST, y_FAST, m_FAST, AD, NumBl, ErrStat, ErrMsg) NextStart = 1 ! whole array do i = 1,p_FAST%Lin_NumMods ThisModule = p_FAST%Lin_ModOrder( i ) + do k=1,size(y_FAST%Lin%Modules(ThisModule)%Instance) y_FAST%Lin%Modules(ThisModule)%Instance(k)%LinStartIndx = NextStart NextStart = NextStart + y_FAST%Lin%Modules(ThisModule)%Instance(k)%SizeLin @@ -147,7 +153,6 @@ SUBROUTINE Init_Lin(p_FAST, y_FAST, m_FAST, AD, NumBl, ErrStat, ErrMsg) ! ................................... ! determine which of the module inputs/outputs are written to file ! ................................... - !NumBl = size(u_ED%BlPitchCom) call Init_Lin_InputOutput(p_FAST, y_FAST, NumBl, ErrStat2, ErrMsg2) call SetErrStat(errStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) @@ -172,7 +177,6 @@ SUBROUTINE Init_Lin(p_FAST, y_FAST, m_FAST, AD, NumBl, ErrStat, ErrMsg) call SetErrStat(errStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) call AllocAry( y_FAST%Lin%Glue%DerivOrder_x, y_FAST%Lin%Glue%SizeLin(LIN_ContSTATE_COL), 'DerivOrder_x', ErrStat2, ErrMsg2) call SetErrStat(errStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - call AllocAry( y_FAST%Lin%Glue%IsLoad_u, y_FAST%Lin%Glue%SizeLin(LIN_INPUT_COL), 'IsLoad_u', ErrStat2, ErrMsg2) call SetErrStat(errStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) @@ -209,7 +213,7 @@ SUBROUTINE Init_Lin(p_FAST, y_FAST, m_FAST, AD, NumBl, ErrStat, ErrMsg) end do ! outputs - do k=1,size(y_FAST%Lin%Modules(ThisModule)%Instance) + do k=1,NumInstances if (NumInstances > 1 .or. trim(y_FAST%Module_Abrev(ThisModule)) == "BD") then ModAbrev = TRIM(y_FAST%Module_Abrev(ThisModule))//'_'//trim(num2lstr(k)) end if @@ -227,11 +231,33 @@ SUBROUTINE Init_Lin(p_FAST, y_FAST, m_FAST, AD, NumBl, ErrStat, ErrMsg) end do ! continuous states - do k=1,size(y_FAST%Lin%Modules(ThisModule)%Instance) + do k=1,NumInstances if (NumInstances > 1 .or. trim(y_FAST%Module_Abrev(ThisModule)) == "BD") then ModAbrev = TRIM(y_FAST%Module_Abrev(ThisModule))//'_'//trim(num2lstr(k)) end if + if (y_FAST%Lin%Modules(ThisModule)%Instance(k)%SizeLin(LIN_ContSTATE_COL) > 0) then + if (p_FAST%WrVTK == VTK_ModeShapes) then ! allocate these for restart later + if (ThisModule == Module_ED) then + ! ED states are only the active DOFs, but when we perturb the OP [in PerturbOP()], we need the index + NumStates = ED%p%NDOF*2 + else + NumStates = y_FAST%Lin%Modules(ThisModule)%Instance(k)%SizeLin(LIN_ContSTATE_COL) + end if + + call AllocAry( y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_x_eig_mag, NumStates, 'op_x_eig_mag', ErrStat2, ErrMsg2) + call SetErrStat(errStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + call AllocAry( y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_x_eig_phase, NumStates, 'op_x_eig_phase', ErrStat2, ErrMsg2) + call SetErrStat(errStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + if (ErrStat >= AbortErrLev) return + + y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_x_eig_mag = 0.0_R8Ki + y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_x_eig_phase = 0.0_R8Ki + end if + end if + + do j=1,y_FAST%Lin%Modules(ThisModule)%Instance(k)%SizeLin(LIN_ContSTATE_COL) y_FAST%Lin%Glue%names_x( i_x) = TRIM(ModAbrev)//' '//y_FAST%Lin%Modules(ThisModule)%Instance(k)%Names_x( j) if (allocated(y_FAST%Lin%Modules(ThisModule)%Instance(k)%RotFrame_x)) then @@ -251,6 +277,62 @@ SUBROUTINE Init_Lin(p_FAST, y_FAST, m_FAST, AD, NumBl, ErrStat, ErrMsg) end do ! each module + + !..................... + ! initialize variables for periodic steady state solution + !..................... + + m_FAST%Lin%NextLinTimeIndx = 1 + m_FAST%Lin%CopyOP_CtrlCode = MESH_NEWCOPY + m_FAST%Lin%n_rot = 0 + m_FAST%Lin%IsConverged = .false. + m_FAST%Lin%FoundSteady = .false. + m_FAST%Lin%AzimIndx = 1 + + p_FAST%AzimDelta = TwoPi / p_FAST%NLinTimes + + ! allocate space to save operating points + if (p_FAST%CalcSteady .or. p_FAST%WrVTK==VTK_ModeShapes) then + + call AllocateOP(p_FAST, y_FAST, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! allocate spaces for variables needed to determine + if (p_FAST%CalcSteady) then + + !call AllocAry(m_FAST%Lin%AzimTarget, p_FAST%NLinTimes,'AzimTarget', ErrStat2, ErrMsg2) + allocate( m_FAST%Lin%AzimTarget(0 : p_FAST%NLinTimes+1), stat=ErrStat2 ) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal,"Unable to allocate space for AzimTarget.",ErrStat,ErrMsg,RoutineName) + end if + + call AllocAry( m_FAST%Lin%LinTimes, p_FAST%NLinTimes, 'LinTimes', ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + call AllocAry( m_FAST%Lin%Psi, p_FAST%LinInterpOrder+1, 'Psi', ErrStat2, ErrMsg2) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! these flattened output arrays will contain spaces for %WriteOutputs, which are being ignored for purposes of CalcSteady computations + call AllocAry( m_FAST%Lin%y_interp, y_FAST%Lin%Glue%SizeLin(LIN_OUTPUT_COL), 'y_interp', ErrStat2, ErrMsg2) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + call AllocAry( m_FAST%Lin%Y_prevRot, y_FAST%Lin%Glue%SizeLin(LIN_OUTPUT_COL), p_FAST%NLinTimes, 'Y_prevRot', ErrStat2, ErrMsg2) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + call AllocAry( m_FAST%Lin%y_ref, y_FAST%Lin%Glue%SizeLin(LIN_OUTPUT_COL), 'y_ref', ErrStat2, ErrMsg2) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + if (ErrStat < AbortErrLev) then + m_FAST%Lin%y_interp = 0.0_R8Ki + m_FAST%Lin%Y_prevRot = 0.0_R8Ki + m_FAST%Lin%y_ref = 1.0_R8Ki + end if + + end if + + end if + + END SUBROUTINE Init_Lin !---------------------------------------------------------------------------------------------------------------------------------- !> Routine that initializes the names and rotating frame portion of IfW. @@ -410,13 +492,14 @@ SUBROUTINE Init_Lin_InputOutput(p_FAST, y_FAST, NumBl, ErrStat, ErrMsg) if (p_FAST%CompHydro == MODULE_HD) then y_FAST%Lin%Modules(MODULE_HD)%Instance(1)%use_u(y_FAST%Lin%Modules(MODULE_HD)%Instance(1)%SizeLin(LIN_INPUT_COL)) = .true. end if - - ! ExtPtfm standard inputs: x1, x1dot x1ddot ! TODO TODO TODO CHECK - if (p_FAST%CompSub == MODULE_ExtPtfm) then - do j = 1,18 - y_FAST%Lin%Modules(MODULE_ExtPtfm)%Instance(1)%use_u(y_FAST%Lin%Modules(MODULE_ExtPtfm)%Instance(1)%SizeLin(LIN_INPUT_COL)+1-j) = .true. - end do - end if + + !bjj: removed because I'm not sure these should be included in the "standard" inputs + !!!! ExtPtfm standard inputs: x1, x1dot x1ddot ! TODO TODO TODO CHECK + !!!if (p_FAST%CompSub == MODULE_ExtPtfm) then + !!! do j = 1,18 + !!! y_FAST%Lin%Modules(MODULE_ExtPtfm)%Instance(1)%use_u(y_FAST%Lin%Modules(MODULE_ExtPtfm)%Instance(1)%SizeLin(LIN_INPUT_COL)+1-j) = .true. + !!! end do + !!!end if elseif(p_FAST%LinInputs == LIN_ALL) then do i = 1,p_FAST%Lin_NumMods @@ -446,7 +529,7 @@ SUBROUTINE Init_Lin_InputOutput(p_FAST, y_FAST, NumBl, ErrStat, ErrMsg) ThisModule = p_FAST%Lin_ModOrder( i ) do k=1,size(y_FAST%Lin%Modules(ThisModule)%Instance) - col = y_FAST%Lin%Modules(ThisModule)%Instance(k)%SizeLin(LIN_OUTPUT_COL) - y_FAST%Lin%Modules(ThisModule)%Instance(k)%NumOutputs !first column where WriteOutput occurs + col = y_FAST%Lin%Modules(ThisModule)%Instance(k)%SizeLin(LIN_OUTPUT_COL) - y_FAST%Lin%Modules(ThisModule)%Instance(k)%NumOutputs !last column before WriteOutput occurs do j=1,col y_FAST%Lin%Modules(ThisModule)%Instance(k)%use_y(j) = .false. end do @@ -469,7 +552,7 @@ SUBROUTINE Init_Lin_InputOutput(p_FAST, y_FAST, NumBl, ErrStat, ErrMsg) END SUBROUTINE Init_Lin_InputOutput !---------------------------------------------------------------------------------------------------------------------------------- !> Routine that performs lineaization at current operating point for a turbine. -SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & +SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & IceF, IceD, MeshMapData, ErrStat, ErrMsg ) REAL(DbKi), INTENT(IN ) :: t_global !< current (global) simulation time @@ -481,13 +564,12 @@ SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD1 TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data - TYPE(AeroDyn14_Data), INTENT(INOUT) :: AD14 !< AeroDyn14 data TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpFM !< OpenFOAM data TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data - TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm data + TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm_MCKF data TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< Data for the MoorDyn module @@ -506,42 +588,62 @@ SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD1 CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Linearize_OP' - REAL(R8Ki), ALLOCATABLE :: dYdz(:,:), dZdz(:,:), dZdu(:,:) REAL(R8Ki), ALLOCATABLE :: dUdu(:,:), dUdy(:,:) ! variables for glue-code linearization +#ifdef OLD_AD_LINEAR + REAL(R8Ki), ALLOCATABLE :: dYdz(:,:), dZdz(:,:), dZdu(:,:) INTEGER(IntKi), ALLOCATABLE :: ipiv(:) +#endif integer(intki) :: NumBl integer(intki) :: k CHARACTER(1024) :: LinRootName CHARACTER(1024) :: OutFileName + CHARACTER(200) :: SimStr + CHARACTER(MaxWrScrLen) :: BlankLine ErrStat = ErrID_None ErrMsg = "" Un = -1 + + !..................... + SimStr = '(RotSpeed='//trim(num2lstr(ED%y%RotSpeed*RPS2RPM))//' rpm, BldPitch1='//trim(num2lstr(ED%y%BlPitch(1)*R2D))//' deg)' + BlankLine = "" + CALL WrOver( BlankLine ) ! BlankLine contains MaxWrScrLen spaces + CALL WrOver ( ' Performing linearization '//trim(num2lstr(m_FAST%Lin%NextLinTimeIndx))//' at simulation time '//TRIM( Num2LStr(t_global) )//' s. '//trim(SimStr) ) + CALL WrScr('') + + !..................... + + LinRootName = TRIM(p_FAST%OutFileRoot)//'.'//trim(num2lstr(m_FAST%Lin%NextLinTimeIndx)) - LinRootName = TRIM(p_FAST%OutFileRoot)//'.'//trim(num2lstr(m_FAST%NextLinTimeIndx)) + if (p_FAST%WrVTK == VTK_ModeShapes .and. .not. p_FAST%CalcSteady) then ! we already saved these for the CalcSteady case + call SaveOP(m_FAST%Lin%NextLinTimeIndx, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + IceF, IceD, ErrStat, ErrMsg, m_FAST%Lin%CopyOP_CtrlCode ) + !m_FAST%Lin%CopyOP_CtrlCode = MESH_UPDATECOPY ! we need a new copy for each LinTime + end if + NumBl = size(ED%Input(1)%BlPitchCom) - y_FAST%Lin%RotSpeed = ED%Output(1)%RotSpeed - y_FAST%Lin%Azimuth = ED%Output(1)%LSSTipPxa + y_FAST%Lin%RotSpeed = ED%y%RotSpeed + y_FAST%Lin%Azimuth = ED%y%LSSTipPxa !..................... ! ElastoDyn !..................... ! get the jacobians call ED_JacobianPInput( t_global, ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), & - ED%Output(1), ED%m, ErrStat2, ErrMsg2, dYdu=y_FAST%Lin%Modules(Module_ED)%Instance(1)%D, dXdu=y_FAST%Lin%Modules(Module_ED)%Instance(1)%B ) + ED%y, ED%m, ErrStat2, ErrMsg2, dYdu=y_FAST%Lin%Modules(Module_ED)%Instance(1)%D, dXdu=y_FAST%Lin%Modules(Module_ED)%Instance(1)%B ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) call ED_JacobianPContState( t_global, ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), & - ED%Output(1), ED%m, ErrStat2, ErrMsg2, dYdx=y_FAST%Lin%Modules(Module_ED)%Instance(1)%C, dXdx=y_FAST%Lin%Modules(Module_ED)%Instance(1)%A ) + ED%y, ED%m, ErrStat2, ErrMsg2, dYdx=y_FAST%Lin%Modules(Module_ED)%Instance(1)%C, dXdx=y_FAST%Lin%Modules(Module_ED)%Instance(1)%A ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) ! get the operating point call ED_GetOP( t_global, ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), & - ED%Output(1), ED%m, ErrStat2, ErrMsg2, u_op=y_FAST%Lin%Modules(Module_ED)%Instance(1)%op_u, y_op=y_FAST%Lin%Modules(Module_ED)%Instance(1)%op_y, & - x_op=y_FAST%Lin%Modules(Module_ED)%Instance(1)%op_x, dx_op=y_FAST%Lin%Modules(Module_ED)%Instance(1)%op_dx ) + ED%y, ED%m, ErrStat2, ErrMsg2, u_op=y_FAST%Lin%Modules(Module_ED)%Instance(1)%op_u, y_op=y_FAST%Lin%Modules(Module_ED)%Instance(1)%op_y, & + x_op=y_FAST%Lin%Modules(Module_ED)%Instance(1)%op_x, dx_op=y_FAST%Lin%Modules(Module_ED)%Instance(1)%op_dx ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) if (ErrStat >=AbortErrLev) then call cleanup() @@ -644,7 +746,9 @@ SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD1 end if end do - end if + end if !BeamDyn + + !..................... ! InflowWind !..................... @@ -739,13 +843,19 @@ SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD1 !..................... if ( p_FAST%CompAero == Module_AD ) then ! get the jacobians - call AD_JacobianPInput( t_global, AD%Input(1), AD%p, AD%x(STATE_CURR), AD%xd(STATE_CURR), AD%z(STATE_CURR), & +#ifdef OLD_AD_LINEAR + call AD_JacobianPInput_orig( t_global, AD%Input(1), AD%p, AD%x(STATE_CURR), AD%xd(STATE_CURR), AD%z(STATE_CURR), & AD%OtherSt(STATE_CURR), AD%y, AD%m, ErrStat2, ErrMsg2, dYdu=y_FAST%Lin%Modules(Module_AD)%Instance(1)%D, dZdu=dZdu ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - + call AD_JacobianPConstrState( t_global, AD%Input(1), AD%p, AD%x(STATE_CURR), AD%xd(STATE_CURR), AD%z(STATE_CURR), & AD%OtherSt(STATE_CURR), AD%y, AD%m, ErrStat2, ErrMsg2, dYdz=dYdz, dZdz=dZdz ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) +#else + call AD_JacobianPInput( t_global, AD%Input(1), AD%p, AD%x(STATE_CURR), AD%xd(STATE_CURR), AD%z(STATE_CURR), & + AD%OtherSt(STATE_CURR), AD%y, AD%m, ErrStat2, ErrMsg2, dYdu=y_FAST%Lin%Modules(Module_AD)%Instance(1)%D ) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) +#endif ! get the operating point call AD_GetOP( t_global, AD%Input(1), AD%p, AD%x(STATE_CURR), AD%xd(STATE_CURR), AD%z(STATE_CURR), & @@ -770,6 +880,7 @@ SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD1 if (p_FAST%LinOutJac) then ! Jacobians +#ifdef OLD_AD_LINEAR ! dZdz: call WrPartialMatrix( dZdz, Un, p_FAST%OutFmt, 'dZdz' ) @@ -778,16 +889,16 @@ SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD1 ! dYdz: call WrPartialMatrix( dYdz, Un, p_FAST%OutFmt, 'dYdz', UseRow=y_FAST%Lin%Modules(Module_AD)%Instance(1)%use_y ) - +#endif !dYdu: call WrPartialMatrix( y_FAST%Lin%Modules(Module_AD)%Instance(1)%D, Un, p_FAST%OutFmt, 'dYdu', & UseRow=y_FAST%Lin%Modules(Module_AD)%Instance(1)%use_y, UseCol=y_FAST%Lin%Modules(Module_AD)%Instance(1)%use_u ) end if +#ifdef OLD_AD_LINEAR end if - call allocAry( ipiv, size(dZdz,1), 'ipiv', ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) if (ErrStat >= AbortErrLev) then @@ -809,60 +920,21 @@ SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD1 !y_FAST%Lin%Modules(Module_AD)%D = y_FAST%Lin%Modules(Module_AD)%D - matmul(dYdz, dZdu ) call LAPACK_GEMM( 'N', 'N', -1.0_R8Ki, dYdz, dZdu, 1.0_R8Ki, y_FAST%Lin%Modules(Module_AD)%Instance(1)%D, ErrStat2, ErrMsg2 ) - if (p_FAST%LinOutMod) then +#endif ! finish writing the file call WrLinFile_txt_End(Un, p_FAST, y_FAST%Lin%Modules(Module_AD)%Instance(1) ) end if +#ifdef OLD_AD_LINEAR ! AD doesn't need these any more, and we may need them for other modules if (allocated(dYdz)) deallocate(dYdz) if (allocated(dZdz)) deallocate(dZdz) if (allocated(dZdu)) deallocate(dZdu) - if (allocated(ipiv)) deallocate(ipiv) - - end if - !..................... - ! ExtPtfm - !..................... - if ( p_FAST%CompSub == Module_ExtPtfm ) then - ! get the jacobians - call ExtPtfm_JacobianPInput( t_global, ExtPtfm%Input(1), ExtPtfm%p, ExtPtfm%x(STATE_CURR), ExtPtfm%xd(STATE_CURR), & - ExtPtfm%z(STATE_CURR), ExtPtfm%OtherSt(STATE_CURR), ExtPtfm%y, ExtPtfm%m, ErrStat2, ErrMsg2, & - dYdu=y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%D, dXdu=y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%B ) - if(Failed()) return; - - call ExtPtfm_JacobianPContState( t_global, ExtPtfm%Input(1), ExtPtfm%p, ExtPtfm%x(STATE_CURR), ExtPtfm%xd(STATE_CURR), & - ExtPtfm%z(STATE_CURR), ExtPtfm%OtherSt(STATE_CURR), ExtPtfm%y, ExtPtfm%m, ErrStat2, ErrMsg2,& - dYdx=y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%C, dXdx=y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%A ) - if(Failed()) return; - - ! get the operating point - call ExtPtfm_GetOP(t_global, ExtPtfm%Input(1), ExtPtfm%p, ExtPtfm%x(STATE_CURR), ExtPtfm%xd(STATE_CURR), ExtPtfm%z(STATE_CURR),& - ExtPtfm%OtherSt(STATE_CURR), ExtPtfm%y, ExtPtfm%m, ErrStat2, ErrMsg2, u_op=y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%op_u,& - y_op=y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%op_y, & - x_op=y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%op_x, dx_op=y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%op_dx) - if(Failed()) return; + if (allocated(ipiv)) deallocate(ipiv) +#endif - ! write the module matrices: - if (p_FAST%LinOutMod) then - OutFileName = trim(LinRootName)//'.'//TRIM(y_FAST%Module_Abrev(Module_ExtPtfm)) - call WrLinFile_txt_Head(t_global, p_FAST, y_FAST, y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1), OutFileName, Un, ErrStat2, ErrMsg2) - if(Failed()) return; - - if (p_FAST%LinOutJac) then - ! Jacobians - call WrPartialMatrix(y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%A, Un, p_FAST%OutFmt, 'dXdx') - call WrPartialMatrix(y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%B, Un, p_FAST%OutFmt, 'dXdu', UseCol=y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%use_u) - call WrPartialMatrix(y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%C, Un, p_FAST%OutFmt, 'dYdx', UseRow=y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%use_y) - call WrPartialMatrix(y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%D, Un, p_FAST%OutFmt, 'dYdu', UseRow=y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%use_y, & - UseCol=y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%use_u) - end if - ! finish writing the file - call WrLinFile_txt_End(Un, p_FAST, y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1) ) - end if - end if ! ExtPtfm - + end if !..................... ! HydroDyn @@ -964,6 +1036,47 @@ SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD1 end if ! if ( p_FAST%LinOutMod ) end if ! if ( p_FAST%CompMooring == Module_MAP ) + !..................... + ! ExtPtfm + !..................... + if ( p_FAST%CompSub == Module_ExtPtfm ) then + ! get the jacobians + call ExtPtfm_JacobianPInput( t_global, ExtPtfm%Input(1), ExtPtfm%p, ExtPtfm%x(STATE_CURR), ExtPtfm%xd(STATE_CURR), & + ExtPtfm%z(STATE_CURR), ExtPtfm%OtherSt(STATE_CURR), ExtPtfm%y, ExtPtfm%m, ErrStat2, ErrMsg2, & + dYdu=y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%D, dXdu=y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%B ) + if(Failed()) return; + + call ExtPtfm_JacobianPContState( t_global, ExtPtfm%Input(1), ExtPtfm%p, ExtPtfm%x(STATE_CURR), ExtPtfm%xd(STATE_CURR), & + ExtPtfm%z(STATE_CURR), ExtPtfm%OtherSt(STATE_CURR), ExtPtfm%y, ExtPtfm%m, ErrStat2, ErrMsg2,& + dYdx=y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%C, dXdx=y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%A ) + if(Failed()) return; + + ! get the operating point + call ExtPtfm_GetOP(t_global, ExtPtfm%Input(1), ExtPtfm%p, ExtPtfm%x(STATE_CURR), ExtPtfm%xd(STATE_CURR), ExtPtfm%z(STATE_CURR),& + ExtPtfm%OtherSt(STATE_CURR), ExtPtfm%y, ExtPtfm%m, ErrStat2, ErrMsg2, u_op=y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%op_u,& + y_op=y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%op_y, & + x_op=y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%op_x, dx_op=y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%op_dx) + if(Failed()) return; + + ! write the module matrices: + if (p_FAST%LinOutMod) then + OutFileName = trim(LinRootName)//'.'//TRIM(y_FAST%Module_Abrev(Module_ExtPtfm)) + call WrLinFile_txt_Head(t_global, p_FAST, y_FAST, y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1), OutFileName, Un, ErrStat2, ErrMsg2) + if(Failed()) return; + + if (p_FAST%LinOutJac) then + ! Jacobians + call WrPartialMatrix(y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%A, Un, p_FAST%OutFmt, 'dXdx') + call WrPartialMatrix(y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%B, Un, p_FAST%OutFmt, 'dXdu', UseCol=y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%use_u) + call WrPartialMatrix(y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%C, Un, p_FAST%OutFmt, 'dYdx', UseRow=y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%use_y) + call WrPartialMatrix(y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%D, Un, p_FAST%OutFmt, 'dYdu', UseRow=y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%use_y, & + UseCol=y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1)%use_u) + end if + ! finish writing the file + call WrLinFile_txt_End(Un, p_FAST, y_FAST%Lin%Modules(Module_ExtPtfm)%Instance(1) ) + end if + end if ! ExtPtfm + !..................... ! Linearization of glue code Input/Output solve: @@ -982,7 +1095,7 @@ SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD1 end if ! get the dUdu and dUdy matrices, which linearize SolveOption2 for the modules we've included in linearization - call Glue_Jacobians( t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, MAPp, FEAM, MD, Orca, & + call Glue_Jacobians( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, MAPp, FEAM, MD, Orca, & IceF, IceD, MeshMapData, dUdu, dUdy, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) if (ErrStat >=AbortErrLev) then @@ -1018,6 +1131,8 @@ SUBROUTINE FAST_Linearize_OP(t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD1 ! Write the results to the file: call WrLinFile_txt_End(Un, p_FAST, y_FAST%Lin%Glue ) + m_FAST%Lin%NextLinTimeIndx = m_FAST%Lin%NextLinTimeIndx + 1 + contains logical function Failed() call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) @@ -1025,16 +1140,18 @@ logical function Failed() if(Failed) call cleanup() end function Failed subroutine cleanup() +#ifdef OLD_AD_LINEAR if (allocated(dYdz)) deallocate(dYdz) if (allocated(dZdz)) deallocate(dZdz) if (allocated(dZdu)) deallocate(dZdu) if (allocated(ipiv)) deallocate(ipiv) +#endif if (allocated(dUdu)) deallocate(dUdu) if (allocated(dUdy)) deallocate(dUdy) if (Un > 0) close(Un) - + end subroutine cleanup END SUBROUTINE FAST_Linearize_OP !---------------------------------------------------------------------------------------------------------------------------------- @@ -1125,6 +1242,7 @@ SUBROUTINE WrLinFile_txt_Head(t_global, p_FAST, y_FAST, LinData, FileName, Un, E Desc = 'Simulation time:'; WRITE (Un, fmt) Desc, t_global, 's' Desc = 'Rotor Speed:'; WRITE (Un, fmt) Desc, y_FAST%Lin%RotSpeed, 'rad/s' Desc = 'Azimuth:'; WRITE (Un, fmt) Desc, y_FAST%Lin%Azimuth, 'rad' + Desc = 'Wind Speed:'; WRITE (Un, fmt) Desc, y_FAST%Lin%WindSpeed, 'm/s' fmt = '(3x,A,1x,I5)' do i=1,size(n) @@ -1233,6 +1351,7 @@ SUBROUTINE WrLinFile_txt_Table(p_FAST, Un, RowCol, op, names, rotFrame, deriv, d INTEGER(IntKi) :: TS ! tab stop column INTEGER(IntKi) :: i, i_print ! loop counter INTEGER(IntKi) :: i_op ! loop counter + logical :: UseDerivNames !< flag that tells us if we need to modify the channel names for derivatives (xdot) logical :: UseThisCol !< flag that tells us if we should use this particular column or skip it logical :: RotatingCol !< flag that tells us if this column is in the rotating frame @@ -1358,6 +1477,7 @@ SUBROUTINE Glue_GetOP(p_FAST, y_FAST, ErrStat, ErrMsg) call SetErrStat(errStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) call AllocAry( y_FAST%Lin%Glue%op_dx, y_FAST%Lin%Glue%SizeLin(LIN_ContSTATE_COL), 'op_dx', ErrStat2, ErrMsg2) call SetErrStat(errStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + if (ErrStat >=AbortErrLev) return end if @@ -1391,6 +1511,7 @@ SUBROUTINE Glue_GetOP(p_FAST, y_FAST, ErrStat, ErrMsg) i_x = i_x + 1; end do end if + end do end do @@ -1398,11 +1519,9 @@ END SUBROUTINE Glue_GetOP !---------------------------------------------------------------------------------------------------------------------------------- !> This routine forms the Jacobian for the glue-code input-output solves. -SUBROUTINE Glue_Jacobians( t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, MAPp, FEAM, MD, Orca, & +SUBROUTINE Glue_Jacobians( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, MAPp, FEAM, MD, Orca, & IceF, IceD, MeshMapData, dUdu, dUdy, ErrStat, ErrMsg ) - REAL(DbKi), INTENT(IN ) :: t_global !< current (global) simulation time - TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables @@ -1410,7 +1529,6 @@ SUBROUTINE Glue_Jacobians( t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data - TYPE(AeroDyn14_Data), INTENT(INOUT) :: AD14 !< AeroDyn14 data TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpFM !< OpenFOAM data @@ -1513,8 +1631,8 @@ SUBROUTINE Glue_Jacobians( t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, ! \f$ \frac{\partial U_\Lambda^{ED}}{\partial u^{BD}} \end{bmatrix} = \f$ (dUdu block row 3=ED) !............ ! we need to do this for CompElast=ED and CompElast=BD - - call Linear_ED_InputSolve_du( p_FAST, y_FAST, ED%Input(1), ED%Output(1), AD%y, AD%Input(1), BD, HD, MAPp, MeshMapData, dUdu, ErrStat2, ErrMsg2 ) + + call Linear_ED_InputSolve_du( p_FAST, y_FAST, ED%Input(1), ED%y, AD%y, AD%Input(1), BD, HD, MAPp, MeshMapData, dUdu, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) !............ @@ -1522,27 +1640,27 @@ SUBROUTINE Glue_Jacobians( t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, ! \f$ \frac{\partial U_\Lambda^{BD}}{\partial u^{BD}} \end{bmatrix} = \f$ (dUdu block row 4=BD) !............ IF (p_FAST%CompElast == Module_BD) THEN - call Linear_BD_InputSolve_du( p_FAST, y_FAST, ED%Output(1), AD%y, AD%Input(1), BD, MeshMapData, dUdu, ErrStat2, ErrMsg2 ) + call Linear_BD_InputSolve_du( p_FAST, y_FAST, ED%y, AD%y, AD%Input(1), BD, MeshMapData, dUdu, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) END IF - + !............ ! \f$ \frac{\partial U_\Lambda^{AD}}{\partial u^{AD}} \end{bmatrix} = \f$ (dUdu block row 5=AD) !............ IF (p_FAST%CompAero == MODULE_AD) THEN - call Linear_AD_InputSolve_du( p_FAST, y_FAST, AD%Input(1), ED%Output(1), BD, MeshMapData, dUdu, ErrStat2, ErrMsg2 ) + call Linear_AD_InputSolve_du( p_FAST, y_FAST, AD%Input(1), ED%y, BD, MeshMapData, dUdu, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) end if IF (p_FAST%CompSub == Module_ExtPtfm) THEN - write(*,*)'>>> FAST_LIN: Linear_ExtPtfm_InputSolve_du, TODO' + CALL WrScr('>>> FAST_LIN: Linear_ExtPtfm_InputSolve_du, TODO') ENDIF !............ - ! \f$ \frac{\partial U_\Lambda^{AD}}{\partial u^{AD}} \end{bmatrix} = \f$ (dUdu block row 5=AD) + ! \f$ \frac{\partial U_\Lambda^{HD}}{\partial u^{HD}} \end{bmatrix} = \f$ (dUdu block row 6=HD) !............ IF (p_FAST%CompHydro == MODULE_HD) THEN - call Linear_HD_InputSolve_du( p_FAST, y_FAST, HD%Input(1), ED%Output(1), MeshMapData, dUdu, ErrStat2, ErrMsg2 ) + call Linear_HD_InputSolve_du( p_FAST, y_FAST, HD%Input(1), ED%y, MeshMapData, dUdu, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) end if @@ -1584,7 +1702,6 @@ SUBROUTINE Glue_Jacobians( t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, end if - !............ ! \f$ \frac{\partial U_\Lambda^{ED}}{\partial y^{SrvD}} \end{bmatrix} = \f$ ! \f$ \frac{\partial U_\Lambda^{ED}}{\partial y^{ED}} \end{bmatrix} = \f$ @@ -1592,7 +1709,7 @@ SUBROUTINE Glue_Jacobians( t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, ! \f$ \frac{\partial U_\Lambda^{ED}}{\partial y^{AD}} \end{bmatrix} = \f$ (dUdy block row 3=ED) !............ - call Linear_ED_InputSolve_dy( p_FAST, y_FAST, ED%Input(1), ED%Output(1), AD%y, AD%Input(1), BD, HD, MAPp, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) + call Linear_ED_InputSolve_dy( p_FAST, y_FAST, ED%Input(1), ED%y, AD%y, AD%Input(1), BD, HD, MAPp, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) !............ @@ -1601,7 +1718,7 @@ SUBROUTINE Glue_Jacobians( t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, ! \f$ \frac{\partial U_\Lambda^{BD}}{\partial y^{AD}} \end{bmatrix} = \f$ (dUdy block row 4=BD) !............ if (p_FAST%CompElast == MODULE_BD) then - call Linear_BD_InputSolve_dy( p_FAST, y_FAST, ED%Input(1), ED%Output(1), AD%y, AD%Input(1), BD, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) + call Linear_BD_InputSolve_dy( p_FAST, y_FAST, ED%Input(1), ED%y, AD%y, AD%Input(1), BD, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) end if @@ -1616,7 +1733,7 @@ SUBROUTINE Glue_Jacobians( t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, call Linear_AD_InputSolve_IfW_dy( p_FAST, y_FAST, AD%Input(1), dUdy ) end if - call Linear_AD_InputSolve_NoIfW_dy( p_FAST, y_FAST, AD%Input(1), ED%Output(1), BD, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) + call Linear_AD_InputSolve_NoIfW_dy( p_FAST, y_FAST, AD%Input(1), ED%y, BD, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) end if @@ -1626,7 +1743,7 @@ SUBROUTINE Glue_Jacobians( t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, ! \f$ \frac{\partial U_\Lambda^{HD}}{\partial y^{ED}} \end{bmatrix} = \f$ (dUdy block row 6=HD) !............ if (p_FAST%CompHydro == MODULE_HD) then - call Linear_HD_InputSolve_dy( p_FAST, y_FAST, HD%Input(1), ED%Output(1), MeshMapData, dUdy, ErrStat2, ErrMsg2 ) + call Linear_HD_InputSolve_dy( p_FAST, y_FAST, HD%Input(1), ED%y, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) end if @@ -1635,12 +1752,12 @@ SUBROUTINE Glue_Jacobians( t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, ! \f$ \frac{\partial U_\Lambda^{MAP}}{\partial y^{ED}} \end{bmatrix} = \f$ (dUdy block row 7=MAP) !............ if (p_FAST%CompMooring == MODULE_MAP) then - call Linear_MAP_InputSolve_dy( p_FAST, y_FAST, MAPp%Input(1), ED%Output(1), MeshMapData, dUdy, ErrStat2, ErrMsg2 ) + call Linear_MAP_InputSolve_dy( p_FAST, y_FAST, MAPp%Input(1), ED%y, MeshMapData, dUdy, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) end if IF (p_FAST%CompSub == Module_ExtPtfm) THEN - write(*,*)'>>> FAST_LIN: Linear_ExtPtfm_InputSolve_dy, TODO' + CALL WrScr('>>> FAST_LIN: Linear_ExtPtfm_InputSolve_dy, TODO') ENDIF END SUBROUTINE Glue_Jacobians @@ -1723,7 +1840,6 @@ SUBROUTINE Linear_ED_InputSolve_du( p_FAST, y_FAST, u_ED, y_ED, y_AD, u_AD, BD, CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message ! local variables - INTEGER(IntKi) :: i ! rows/columns INTEGER(IntKi) :: K ! Loops through blades INTEGER(IntKi) :: BD_Start ! starting index of dUdu (column) where BD root motion inputs are located INTEGER(IntKi) :: AD_Start_Bl ! starting index of dUdu (column) where AD blade motion inputs are located @@ -2019,7 +2135,7 @@ SUBROUTINE Linear_AD_InputSolve_du( p_FAST, y_FAST, u_AD, y_ED, BD, MeshMapData, ! tower IF (u_AD%TowerMotion%Committed) THEN - + CALL Linearize_Line2_to_Line2( y_ED%TowerLn2Mesh, u_AD%TowerMotion, MeshMapData%ED_L_2_AD_L_T, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName//':u_AD%TowerMotion' ) @@ -2080,17 +2196,18 @@ SUBROUTINE Linear_SrvD_InputSolve_dy( p_FAST, y_FAST, dUdy ) REAL(R8Ki), INTENT(INOUT) :: dUdy(:,:) !< Jacobian matrix of which we are computing the dU^{SrvD}/dy^{ED} block integer(intKi) :: ED_Start_Yaw !< starting index of dUdy (column) where ED Yaw/YawRate/HSS_Spd outputs are located (just before WriteOutput) - + integer(intKi) :: thisModule INTEGER(IntKi) :: i ! loop counter CHARACTER(*), PARAMETER :: RoutineName = 'Linear_SrvD_InputSolve_dy' - ED_Start_Yaw = y_FAST%Lin%Modules(Module_ED)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + y_FAST%Lin%Modules(Module_ED)%Instance(1)%SizeLin(LIN_OUTPUT_COL) & !end of ED outputs (+1) - - y_FAST%Lin%Modules(Module_ED)%Instance(1)%NumOutputs - 3 ! start of ED where Yaw, YawRate, HSS_Spd occur (right before WriteOutputs) - do i=1,3 - dUdy(y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + i - 1, ED_Start_Yaw + i - 1) = -1.0_ReKi + thisModule = Module_ED + ED_Start_Yaw = Indx_y_Yaw_Start(y_FAST, ThisModule) ! start of ED where Yaw, YawRate, HSS_Spd occur (right before WriteOutputs) + + do i=1,size(SrvD_Indx_Y_BlPitchCom) + dUdy(y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + SrvD_Indx_Y_BlPitchCom(i) - 1, ED_Start_Yaw + i - 1) = -1.0_ReKi end do !IF (u_SrvD%NTMD%Mesh%Committed) THEN @@ -2152,10 +2269,9 @@ SUBROUTINE Linear_ED_InputSolve_dy( p_FAST, y_FAST, u_ED, y_ED, y_AD, u_AD, BD, ! BlPitchCom, YawMom, GenTrq ED_Start = Indx_u_ED_BlPitchCom_Start(u_ED, y_FAST) do i=1,size(u_ED%BlPitchCom)+2 ! BlPitchCom, YawMom, GenTrq (NOT collective pitch) - dUdy(ED_Start + i - 1, y_FAST%Lin%Modules(Module_SrvD)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + i - 1) = -1.0_ReKi + dUdy(ED_Start + i - 1, y_FAST%Lin%Modules(Module_SrvD)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + i - 1) = -1.0_ReKi !SrvD_Indx_Y_BlPitchCom end do - !IF (y_SrvD%NTMD%Mesh%Committed) THEN ! CALL Linearize_Point_to_Point( y_SrvD%NTMD%Mesh, u_ED%NacelleLoads, MeshMapData%SrvD_P_2_ED_P_N, ErrStat2, ErrMsg2, u_SrvD%NTMD%Mesh, y_ED%NacelleMotion ) ! CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg,RoutineName//':u_ED%NacelleLoads' ) @@ -2250,7 +2366,7 @@ SUBROUTINE Linear_ED_InputSolve_dy( p_FAST, y_FAST, u_ED, y_ED, y_AD, u_AD, BD, !!! ! while forming dUdy, too. ! call Linearize_Point_to_Point( HD%y%AllHdroOrigin, u_ED%PlatformPtMesh, MeshMapData%HD_W_P_2_ED_P, ErrStat2, ErrMsg2, HD%Input(1)%Mesh, y_ED%PlatformPtMesh) !HD%Input(1)%Mesh and y_ED%PlatformPtMesh contain the displaced positions for load calculations HD_Out_Start = Indx_y_HD_AllHdro_Start(HD%y, y_FAST) - ED_Start = Indx_u_ED_Platform_Start(u_ED, y_FAST) ! start of u_ED%PlatformPtMesh%TranslationDisp field + ED_Start = Indx_u_ED_Platform_Start(u_ED, y_FAST) ! start of u_ED%PlatformPtMesh%Moment field call Assemble_dUdy_Loads(HD%y%AllHdroOrigin, u_ED%PlatformPtMesh, MeshMapData%HD_W_P_2_ED_P, ED_Start, HD_Out_Start, dUdy) ! ED translation displacement-to-ED moment transfer (dU^{ED}/dy^{ED}): @@ -2293,7 +2409,7 @@ SUBROUTINE Linear_BD_InputSolve_dy( p_FAST, y_FAST, u_ED, y_ED, y_AD, u_AD, BD, TYPE(ED_InputType), INTENT(INOUT) :: u_ED !< ED Inputs at t TYPE(ED_OutputType), INTENT(IN ) :: y_ED !< ElastoDyn outputs (need translation displacement on meshes for loads mapping) TYPE(AD_OutputType), INTENT(IN ) :: y_AD !< AeroDyn outputs - TYPE(AD_InputType), INTENT(INOUT) :: u_AD !< AD inputs (for AD-ED load linerization) + TYPE(AD_InputType), INTENT(INOUT) :: u_AD !< AD inputs (for AD-ED load linearization) TYPE(BeamDyn_Data), INTENT(IN ) :: BD !< BD data at t TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules @@ -2710,11 +2826,8 @@ SUBROUTINE Linear_HD_InputSolve_dy( p_FAST, y_FAST, u_HD, y_ED, MeshMapData, dUd ! Local variables: - INTEGER(IntKi) :: K ! Loops through blades INTEGER(IntKi) :: HD_Start ! starting index of dUdy (column) where particular HD fields are located INTEGER(IntKi) :: ED_Out_Start! starting index of dUdy (row) where particular ED fields are located - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Linear_HD_InputSolve_dy' @@ -2764,6 +2877,7 @@ SUBROUTINE Linear_HD_InputSolve_dy( p_FAST, y_FAST, u_HD, y_ED, MeshMapData, dUd ED_Out_Start = Indx_y_ED_Platform_Start(y_ED, y_FAST) ! start of y_ED%PlatformPtMesh%TranslationDisp field call Assemble_dUdy_Motions(y_ED%PlatformPtMesh, u_HD%Mesh, MeshMapData%ED_P_2_HD_W_P, HD_Start, ED_Out_Start, dUdy, .false.) + END IF @@ -2803,10 +2917,12 @@ SUBROUTINE Linear_MAP_InputSolve_dy( p_FAST, y_FAST, u_MAP, y_ED, MeshMapData, d !................................... IF (u_MAP%PtFairDisplacement%Committed) THEN MAP_Start = y_FAST%Lin%Modules(MODULE_MAP)%Instance(1)%LinStartIndx(LIN_INPUT_COL) + ED_Out_Start = Indx_y_ED_Platform_Start(y_ED, y_FAST) ! start of y_ED%PlatformPtMesh%TranslationDisp field call Linearize_Point_to_Point( y_ED%PlatformPtMesh, u_MAP%PtFairDisplacement, MeshMapData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) - call Assemble_dUdy_Motions(y_ED%PlatformPtMesh, u_MAP%PtFairDisplacement, MeshMapData%ED_P_2_Mooring_P, MAP_Start, ED_Out_Start, dUdy, onlyTranslationDisp=.true.) + call Assemble_dUdy_Motions(y_ED%PlatformPtMesh, u_MAP%PtFairDisplacement, MeshMapData%ED_P_2_Mooring_P, MAP_Start, ED_Out_Start, dUdy, OnlyTranslationDisp=.true.) + END IF @@ -3521,9 +3637,9 @@ SUBROUTINE Assemble_dUdy_Loads(y, u, MeshMap, BlockRowStart, BlockColStart, dUdy row = BlockRowStart + u%NNodes*3 ! start of u%Moment field [skip 1 field with 3 components] col = BlockColStart ! start of y%Force field call SetBlockMatrix( dUdy, MeshMap%dM%m_f, row, col ) -!LIN-TODO: There are no moments for the MAP outputs! Need to modifiy this could + if (allocated(y%Moment)) then - ! source moment to moment: + ! source moment to destination moment: row = BlockRowStart + u%NNodes*3 ! start of u%Moment field [skip 1 field with 3 components] col = BlockColStart + y%NNodes*3 ! start of y%Moment field [skip 1 field with 3 components] call SetBlockMatrix( dUdy, MeshMap%dM%li, row, col ) @@ -3673,6 +3789,19 @@ FUNCTION Indx_y_ED_BladeRoot_Start(y_ED, y_FAST, BladeNum) RESULT(ED_Out_Start) end do END FUNCTION Indx_y_ED_BladeRoot_Start !---------------------------------------------------------------------------------------------------------------------------------- +!> This routine returns the starting index for y_ED%Yaw in the FAST linearization outputs. +FUNCTION Indx_y_Yaw_Start(y_FAST, ThisModule) RESULT(ED_Out_Start) + TYPE(FAST_OutputFileType), INTENT(IN ) :: y_FAST !< FAST output file data (for linearization) + INTEGER, INTENT(IN ) :: ThisModule !< which structural module this is for + + INTEGER :: ED_Out_Start !< starting index of this blade mesh in ElastoDyn outputs + + + ED_Out_Start = y_FAST%Lin%Modules(thisModule)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + y_FAST%Lin%Modules(thisModule)%Instance(1)%SizeLin(LIN_OUTPUT_COL) & !end of ED outputs (+1) + - y_FAST%Lin%Modules(thisModule)%Instance(1)%NumOutputs - 3 ! start of ED where Yaw, YawRate, HSS_Spd occur (right before WriteOutputs) + +END FUNCTION Indx_y_Yaw_Start +!---------------------------------------------------------------------------------------------------------------------------------- !---------------------------------------------------------------------------------------------------------------------------------- !> This routine returns the starting index for the u_AD%TowerMotion mesh in the FAST linearization inputs. @@ -3826,4 +3955,1667 @@ FUNCTION Indx_y_HD_AllHdro_Start(y_HD, y_FAST) RESULT(HD_Start) if (y_HD%Mesh%committed) HD_Start = HD_Start + y_HD%Mesh%NNodes * 6 ! 2 fields (MASKID_FORCE,MASKID_MOMENT) with 3 components END FUNCTION Indx_y_HD_AllHdro_Start + + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This subroutine allocates the arrays that store the operating point at each linearization time for later producing VTK +!! files of the mode shapes. +SUBROUTINE AllocateOP(p_FAST, y_FAST, ErrStat, ErrMsg ) + + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! local variables + INTEGER(IntKi) :: ErrStat2 + CHARACTER(*), PARAMETER :: RoutineName = 'AllocateOP' + + + ErrStat = ErrID_None + ErrMsg = "" + + !---------------------------------------------------------------------------------------- + !! copy the operating point of the states and inputs at LinTimes(i) + !---------------------------------------------------------------------------------------- + + + ALLOCATE( y_FAST%op%x_ED(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%xd_ED(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%z_ED(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%OtherSt_ED(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%u_ED(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + + IF ( p_FAST%CompElast == Module_BD ) THEN + ALLOCATE( y_FAST%op%x_BD(p_FAST%nBeams, p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%xd_BD(p_FAST%nBeams, p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%z_BD(p_FAST%nBeams, p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%OtherSt_BD(p_FAST%nBeams, p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%u_BD(p_FAST%nBeams, p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + END IF + + + + !IF ( p_FAST%CompAero == Module_AD14 ) THEN + !ELSE + IF ( p_FAST%CompAero == Module_AD ) THEN + ALLOCATE( y_FAST%op%x_AD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%xd_AD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%z_AD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%OtherSt_AD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%u_AD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + END IF + + IF ( p_FAST%CompInflow == Module_IfW ) THEN + ALLOCATE( y_FAST%op%x_IfW(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%xd_IfW(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%z_IfW(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%OtherSt_IfW(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%u_IfW(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + END IF + + + IF ( p_FAST%CompServo == Module_SrvD ) THEN + ALLOCATE( y_FAST%op%x_SrvD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%xd_SrvD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%z_SrvD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%OtherSt_SrvD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%u_SrvD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + END IF + + + IF ( p_FAST%CompHydro == Module_HD ) THEN + ALLOCATE( y_FAST%op%x_HD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%xd_HD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%z_HD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%OtherSt_HD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%u_HD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + END IF + + + ! SubDyn: copy final predictions to actual states + IF ( p_FAST%CompSub == Module_SD ) THEN + ALLOCATE( y_FAST%op%x_SD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%xd_SD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%z_SD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%OtherSt_SD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%u_SD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ELSE IF ( p_FAST%CompSub == Module_ExtPtfm ) THEN + ALLOCATE( y_FAST%op%x_ExtPtfm(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%xd_ExtPtfm(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%z_ExtPtfm(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%OtherSt_ExtPtfm(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%u_ExtPtfm(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + END IF + + + ! MAP/MoorDyn/FEAM: copy states and inputs to OP array + IF (p_FAST%CompMooring == Module_MAP) THEN + ALLOCATE( y_FAST%op%x_MAP(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%xd_MAP(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%z_MAP(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + !ALLOCATE( y_FAST%op%OtherSt_MAP(p_FAST%NLinTimes), STAT=ErrStat2 ) + ! if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%u_MAP(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ELSEIF (p_FAST%CompMooring == Module_MD) THEN + ALLOCATE( y_FAST%op%x_MD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%xd_MD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%z_MD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%OtherSt_MD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%u_MD(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ELSEIF (p_FAST%CompMooring == Module_FEAM) THEN + ALLOCATE( y_FAST%op%x_FEAM(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%xd_FEAM(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%z_FEAM(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%OtherSt_FEAM(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%u_FEAM(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + !ELSEIF (p_FAST%CompMooring == Module_Orca) THEN + END IF + + ! IceFloe/IceDyn: copy states and inputs to OP array + IF ( p_FAST%CompIce == Module_IceF ) THEN + ALLOCATE( y_FAST%op%x_IceF(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%xd_IceF(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%z_IceF(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%OtherSt_IceF(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%u_IceF(p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ELSEIF ( p_FAST%CompIce == Module_IceD ) THEN + ALLOCATE( y_FAST%op%x_IceD(p_FAST%numIceLegs, p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%xd_IceD(p_FAST%numIceLegs, p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%z_IceD(p_FAST%numIceLegs, p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%OtherSt_IceD(p_FAST%numIceLegs, p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + ALLOCATE( y_FAST%op%u_IceD(p_FAST%numIceLegs, p_FAST%NLinTimes), STAT=ErrStat2 ) + if (ErrStat2 /= 0) call SetErrStat( ErrID_Fatal, 'Error allocating arrays for VTK operating points.', ErrStat, ErrMsg, RoutineName) + END IF + +END SUBROUTINE AllocateOP +!---------------------------------------------------------------------------------------------------------------------------------- +!> This subroutine is the inverse of SetOperatingPoint(). It saves the current operating points so they can be retrieved +!> when visualizing mode shapes. +SUBROUTINE SaveOP(i, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + IceF, IceD, ErrStat, ErrMsg, CtrlCode ) + + INTEGER(IntKi) , INTENT(IN ) :: i !< current index into LinTimes + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data + TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpFM !< OpenFOAM data + TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data + TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm_MCKF data + TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data + TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< Data for the MoorDyn module + TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data + TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data + TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop + + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + INTEGER(IntKi), INTENT(IN ) :: CtrlCode !< mesh copy control code (new, vs update) + + ! local variables + INTEGER(IntKi) :: k ! generic loop counters + + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SaveOP' + + + ErrStat = ErrID_None + ErrMsg = "" + + + !---------------------------------------------------------------------------------------- + !! copy the operating point of the states and inputs at LinTimes(i) + !---------------------------------------------------------------------------------------- + + ! ElastoDyn: copy states and inputs to OP array + CALL ED_CopyContState (ED%x( STATE_CURR), y_FAST%op%x_ED( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyDiscState (ED%xd(STATE_CURR), y_FAST%op%xd_ED( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyConstrState (ED%z( STATE_CURR), y_FAST%op%z_ED( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyOtherState (ED%OtherSt( STATE_CURR), y_FAST%op%OtherSt_ED( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL ED_CopyInput (ED%Input(1), y_FAST%op%u_ED( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! BeamDyn: copy states and inputs to OP array + IF ( p_FAST%CompElast == Module_BD ) THEN + DO k=1,p_FAST%nBeams + CALL BD_CopyContState (BD%x( k,STATE_CURR), y_FAST%op%x_BD(k, i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyDiscState (BD%xd(k,STATE_CURR), y_FAST%op%xd_BD(k, i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyConstrState (BD%z( k,STATE_CURR), y_FAST%op%z_BD(k, i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyOtherState (BD%OtherSt( k,STATE_CURR), y_FAST%op%OtherSt_BD(k, i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL BD_CopyInput (BD%Input(1,k), y_FAST%op%u_BD(k, i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END DO + END IF + + + + ! AeroDyn: copy states and inputs to OP array + !IF ( p_FAST%CompAero == Module_AD14 ) THEN + !ELSE + IF ( p_FAST%CompAero == Module_AD ) THEN + CALL AD_CopyContState (AD%x( STATE_CURR), y_FAST%op%x_AD( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyDiscState (AD%xd(STATE_CURR), y_FAST%op%xd_AD( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyConstrState (AD%z( STATE_CURR), y_FAST%op%z_AD( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyOtherState (AD%OtherSt(STATE_CURR), y_FAST%op%OtherSt_AD( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL AD_CopyInput (AD%Input(1), y_FAST%op%u_AD(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + + ! InflowWind: copy states and inputs to OP array + IF ( p_FAST%CompInflow == Module_IfW ) THEN + CALL InflowWind_CopyContState (IfW%x( STATE_CURR), y_FAST%op%x_IfW( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyDiscState (IfW%xd(STATE_CURR), y_FAST%op%xd_IfW( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyConstrState (IfW%z( STATE_CURR), y_FAST%op%z_IfW( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyOtherState( IfW%OtherSt( STATE_CURR), y_FAST%op%OtherSt_IfW( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL InflowWind_CopyInput (IfW%Input(1), y_FAST%op%u_IfW(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END IF + + + ! ServoDyn: copy states and inputs to OP array + IF ( p_FAST%CompServo == Module_SrvD ) THEN + CALL SrvD_CopyContState (SrvD%x( STATE_CURR), y_FAST%op%x_SrvD( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyDiscState (SrvD%xd(STATE_CURR), y_FAST%op%xd_SrvD( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyConstrState (SrvD%z( STATE_CURR), y_FAST%op%z_SrvD( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyOtherState (SrvD%OtherSt( STATE_CURR), y_FAST%op%OtherSt_SrvD( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL SrvD_CopyInput (SrvD%Input(1), y_FAST%op%u_SrvD(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + + + ! HydroDyn: copy states and inputs to OP array + IF ( p_FAST%CompHydro == Module_HD ) THEN + CALL HydroDyn_CopyContState (HD%x( STATE_CURR), y_FAST%op%x_HD( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyDiscState (HD%xd(STATE_CURR), y_FAST%op%xd_HD( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyConstrState (HD%z( STATE_CURR), y_FAST%op%z_HD( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyOtherState (HD%OtherSt(STATE_CURR), y_FAST%op%OtherSt_HD( i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL HydroDyn_CopyInput (HD%Input(1), y_FAST%op%u_HD(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + + + ! SubDyn: copy final predictions to actual states + IF ( p_FAST%CompSub == Module_SD ) THEN + CALL SD_CopyContState (y_FAST%op%x_SD(i), SD%x( STATE_CURR), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyDiscState (y_FAST%op%xd_SD(i), SD%xd(STATE_CURR), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyConstrState( y_FAST%op%z_SD(i), SD%z( STATE_CURR), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyOtherState (y_FAST%op%OtherSt_SD(i), SD%OtherSt(STATE_CURR), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL SD_CopyInput (y_FAST%op%u_SD(i), SD%Input(1), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ELSE IF ( p_FAST%CompSub == Module_ExtPtfm ) THEN + CALL ExtPtfm_CopyContState (ExtPtfm%x( STATE_CURR), y_FAST%op%x_ExtPtfm(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyDiscState (ExtPtfm%xd(STATE_CURR), y_FAST%op%xd_ExtPtfm(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyConstrState (ExtPtfm%z( STATE_CURR), y_FAST%op%z_ExtPtfm(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyOtherState (ExtPtfm%OtherSt(STATE_CURR), y_FAST%op%OtherSt_ExtPtfm(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL ExtPtfm_CopyInput (ExtPtfm%Input(1), y_FAST%op%u_ExtPtfm(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + + + ! MAP/MoorDyn/FEAM: copy states and inputs to OP array + IF (p_FAST%CompMooring == Module_MAP) THEN + CALL MAP_CopyContState (MAPp%x( STATE_CURR), y_FAST%op%x_MAP(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MAP_CopyDiscState (MAPp%xd(STATE_CURR), y_FAST%op%xd_MAP(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MAP_CopyConstrState (MAPp%z( STATE_CURR), y_FAST%op%z_MAP(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + !CALL MAP_CopyOtherState (MAPp%OtherSt(STATE_CURR), y_FAST%op%OtherSt_MAP(i), CtrlCode, Errstat2, ErrMsg2) + ! CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL MAP_CopyInput (MAPp%Input(1), y_FAST%op%u_MAP(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ELSEIF (p_FAST%CompMooring == Module_MD) THEN + CALL MD_CopyContState (MD%x( STATE_CURR), y_FAST%op%x_MD(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyDiscState (MD%xd(STATE_CURR), y_FAST%op%xd_MD(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyConstrState (MD%z( STATE_CURR), y_FAST%op%z_MD(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyOtherState (MD%OtherSt(STATE_CURR), y_FAST%op%OtherSt_MD(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL MD_CopyInput (MD%Input(1), y_FAST%op%u_MD(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ELSEIF (p_FAST%CompMooring == Module_FEAM) THEN + CALL FEAM_CopyContState (FEAM%x( STATE_CURR), y_FAST%op%x_FEAM(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyDiscState (FEAM%xd(STATE_CURR), y_FAST%op%xd_FEAM(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyConstrState (FEAM%z( STATE_CURR), y_FAST%op%z_FEAM(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyOtherState (FEAM%OtherSt( STATE_CURR), y_FAST%op%OtherSt_FEAM(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL FEAM_CopyInput (FEAM%Input(1), y_FAST%op%u_FEAM(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + !ELSEIF (p_FAST%CompMooring == Module_Orca) THEN + END IF + + ! IceFloe/IceDyn: copy states and inputs to OP array + IF ( p_FAST%CompIce == Module_IceF ) THEN + CALL IceFloe_CopyContState (IceF%x( STATE_CURR), y_FAST%op%x_IceF(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyDiscState (IceF%xd(STATE_CURR), y_FAST%op%xd_IceF(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyConstrState (IceF%z( STATE_CURR), y_FAST%op%z_IceF(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyOtherState (IceF%OtherSt(STATE_CURR), y_FAST%op%OtherSt_IceF(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL IceFloe_CopyInput (IceF%Input(1), y_FAST%op%u_IceF(i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ELSEIF ( p_FAST%CompIce == Module_IceD ) THEN + DO k=1,p_FAST%numIceLegs + CALL IceD_CopyContState (IceD%x( k,STATE_CURR), y_FAST%op%x_IceD(k, i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyDiscState (IceD%xd(k,STATE_CURR), y_FAST%op%xd_IceD(k, i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyConstrState (IceD%z( k,STATE_CURR), y_FAST%op%z_IceD(k, i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyOtherState (IceD%OtherSt( k,STATE_CURR), y_FAST%op%OtherSt_IceD(k, i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL IceD_CopyInput (IceD%Input(1,k), y_FAST%op%u_IceD(k, i), CtrlCode, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + END IF + + +END SUBROUTINE SaveOP +!---------------------------------------------------------------------------------------------------------------------------------- +!> This subroutine takes arrays representing the eigenvector of the states and uses it to modify the operating points for +!! continuous states. It is highly tied to the module organizaton. +SUBROUTINE PerturbOP(t, iLinTime, iMode, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + IceF, IceD, ErrStat, ErrMsg ) + + REAL(DbKi), INTENT(IN ) :: t + INTEGER(IntKi), INTENT(IN ) :: iLinTime !< index into LinTimes dimension of arrays (azimuth) + INTEGER(IntKi), INTENT(IN ) :: iMode !< index into Mode dimension of arrays + + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data + TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpFM !< OpenFOAM data + TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data + TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm_MCKF data + TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data + TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< Data for the MoorDyn module + TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data + TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data + TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop + + + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! local variables + INTEGER(IntKi) :: k ! generic loop counters + INTEGER(IntKi) :: i ! generic loop counters + INTEGER(IntKi) :: j ! generic loop counters + INTEGER(IntKi) :: indx ! generic loop counters + INTEGER(IntKi) :: indx_last ! generic loop counters + INTEGER(IntKi) :: i_x ! index into packed array + INTEGER(IntKi) :: nStates ! number of second-order states + INTEGER(IntKi) :: ThisModule ! identifier of current module + + CHARACTER(*), PARAMETER :: RoutineName = 'PerturbOP' + + + ErrStat = ErrID_None + ErrMsg = "" + + + i_x = 1 + + do i = 1,p_FAST%Lin_NumMods + ThisModule = p_FAST%Lin_ModOrder( i ) + + do k=1,size(y_FAST%Lin%Modules(ThisModule)%Instance) + + if (allocated(y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_x_eig_mag)) then + do j=1,size(y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_x) ! use this for the loop because ED may have a larger op_x_eig_mag array than op_x + + ! this is a hack because not all modules pack the continuous states in the same way: + if (ThisModule == Module_ED) then + if (j<= ED%p%DOFs%NActvDOF) then + indx = ED%p%DOFs%PS(j) + else + indx = ED%p%DOFs%PS(j-ED%p%DOFs%NActvDOF) + ED%p%NDOF + end if + else + indx = j + end if + y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_x_eig_mag( indx) = p_FAST%VTK_modes%x_eig_magnitude(i_x, iLinTime, iMode) ! this is going to hold the magnitude of the eigenvector + y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_x_eig_phase(indx) = p_FAST%VTK_modes%x_eig_phase( i_x, iLinTime, iMode) ! this is going to hold the phase of the eigenvector + i_x = i_x + 1; + end do + end if + + end do + end do + + + + ! ElastoDyn: + ThisModule = Module_ED + if (allocated(y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_mag)) then + nStates = size(y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_mag)/2 + + call GetStateAry(p_FAST, iMode, t, ED%x( STATE_CURR)%QT, y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_mag( :nStates), y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_phase( :nStates)) + call GetStateAry(p_FAST, iMode, t, ED%x( STATE_CURR)%QDT, y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_mag(1+nStates: ), y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_phase(1+nStates: )) + end if + + ! BeamDyn: + IF ( p_FAST%CompElast == Module_BD ) THEN + ThisModule = Module_BD + DO k=1,p_FAST%nBeams + if (allocated(y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_x_eig_mag)) then + nStates = size(y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_x_eig_mag)/2 + + indx = 1 + do i=2,BD%p(k)%node_total + indx_last = indx + BD%p(k)%dof_node - 1 + call GetStateAry(p_FAST, iMode, t, BD%x(k, STATE_CURR)%q( :,i), y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_x_eig_mag( indx:indx_last ), y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_x_eig_phase( indx:indx_last )) + call GetStateAry(p_FAST, iMode, t, BD%x(k, STATE_CURR)%dqdt(:,i), y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_x_eig_mag(nStates+indx:indx_last+nStates), y_FAST%Lin%Modules(ThisModule)%Instance(k)%op_x_eig_phase(nStates+indx:indx_last+nStates)) + indx = indx_last+1 + end do + + end if + + END DO + END IF + + + !!! ! AeroDyn: copy final predictions to actual states; copy current outputs to next + !!!!IF ( p_FAST%CompAero == Module_AD14 ) THEN + !!!!ELSE + !!!IF ( p_FAST%CompAero == Module_AD ) THEN + !!!END IF + !!! + !!!! InflowWind: copy op to actual states and inputs + !!!IF ( p_FAST%CompInflow == Module_IfW ) THEN + !!!END IF + !!! + !!! + !!!! ServoDyn: copy op to actual states and inputs + !!!IF ( p_FAST%CompServo == Module_SrvD ) THEN + !!!END IF + + + ! HydroDyn: copy op to actual states and inputs + IF ( p_FAST%CompHydro == Module_HD ) THEN + ThisModule = Module_HD + if (allocated(y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_mag)) then + nStates = HD%p%WAMIT%SS_Exctn%N + if (nStates > 0) then + call GetStateAry(p_FAST, iMode, t, HD%x( STATE_CURR)%WAMIT%SS_Exctn%x, y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_mag( :nStates), y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_phase( :nStates)) + end if + if (nStates < size(y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_mag)) then + call GetStateAry(p_FAST, iMode, t, HD%x( STATE_CURR)%WAMIT%SS_Rdtn%x, y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_mag(1+nStates: ), y_FAST%Lin%Modules(ThisModule)%Instance(1)%op_x_eig_phase(1+nStates: )) + end if + end if + END IF + + + !!!! SubDyn: copy final predictions to actual states + !!!IF ( p_FAST%CompSub == Module_SD ) THEN + !!!ELSE IF ( p_FAST%CompSub == Module_ExtPtfm ) THEN + !!!END IF + !!! + !!! + !!!! MAP/MoorDyn/FEAM: copy op to actual states and inputs + !!!IF (p_FAST%CompMooring == Module_MAP) THEN + !!!ELSEIF (p_FAST%CompMooring == Module_MD) THEN + !!!ELSEIF (p_FAST%CompMooring == Module_FEAM) THEN + !!!!ELSEIF (p_FAST%CompMooring == Module_Orca) THEN + !!!END IF + !!! + !!! ! IceFloe/IceDyn: copy op to actual states and inputs + !!!IF ( p_FAST%CompIce == Module_IceF ) THEN + !!!ELSEIF ( p_FAST%CompIce == Module_IceD ) THEN + !!! DO k=1,p_FAST%numIceLegs + !!! END DO + !!!END IF + + +END SUBROUTINE PerturbOP +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE SetOperatingPoint(i, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, ExtPtfm, & + MAPp, FEAM, MD, Orca, IceF, IceD, ErrStat, ErrMsg ) + + INTEGER(IntKi), INTENT(IN ) :: i !< Index into LinTimes (to determine which operating point to copy) + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data + TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpFM !< OpenFOAM data + TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data + TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm_MCKF data + TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data + TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< Data for the MoorDyn module + TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data + TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data + TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop + + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! local variables + INTEGER(IntKi) :: k ! generic loop counters + + + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'SetOperatingPoint' + + + ErrStat = ErrID_None + ErrMsg = "" + + + !---------------------------------------------------------------------------------------- + !! copy the operating point of the states and inputs at LinTimes(i) + !---------------------------------------------------------------------------------------- + ! ElastoDyn: copy op to actual states and inputs + CALL ED_CopyContState (y_FAST%op%x_ED( i), ED%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyDiscState (y_FAST%op%xd_ED( i), ED%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyConstrState (y_FAST%op%z_ED( i), ED%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyOtherState (y_FAST%op%OtherSt_ED( i), ED%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL ED_CopyInput (y_FAST%op%u_ED( i), ED%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! BeamDyn: copy op to actual states and inputs + IF ( p_FAST%CompElast == Module_BD ) THEN + DO k=1,p_FAST%nBeams + CALL BD_CopyContState (y_FAST%op%x_BD(k, i), BD%x( k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyDiscState (y_FAST%op%xd_BD(k, i), BD%xd(k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyConstrState (y_FAST%op%z_BD(k, i), BD%z( k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL BD_CopyOtherState (y_FAST%op%OtherSt_BD(k, i), BD%OtherSt( k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL BD_CopyInput (y_FAST%op%u_BD(k, i), BD%Input(1, k), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END DO + END IF + + ! AeroDyn: copy final predictions to actual states; copy current outputs to next + !IF ( p_FAST%CompAero == Module_AD14 ) THEN + !ELSE + IF ( p_FAST%CompAero == Module_AD ) THEN + CALL AD_CopyContState (y_FAST%op%x_AD( i), AD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyDiscState (y_FAST%op%xd_AD( i), AD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyConstrState (y_FAST%op%z_AD( i), AD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL AD_CopyOtherState (y_FAST%op%OtherSt_AD( i), AD%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL AD_CopyInput (y_FAST%op%u_AD(i), AD%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + + ! InflowWind: copy op to actual states and inputs + IF ( p_FAST%CompInflow == Module_IfW ) THEN + CALL InflowWind_CopyContState (y_FAST%op%x_IfW( i), IfW%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyDiscState (y_FAST%op%xd_IfW( i), IfW%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyConstrState (y_FAST%op%z_IfW( i), IfW%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL InflowWind_CopyOtherState (y_FAST%op%OtherSt_IfW( i), IfW%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL InflowWind_CopyInput (y_FAST%op%u_IfW(i), IfW%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + END IF + + + ! ServoDyn: copy op to actual states and inputs + IF ( p_FAST%CompServo == Module_SrvD ) THEN + CALL SrvD_CopyContState (y_FAST%op%x_SrvD( i), SrvD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyDiscState (y_FAST%op%xd_SrvD( i), SrvD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyConstrState (y_FAST%op%z_SrvD( i), SrvD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_CopyOtherState (y_FAST%op%OtherSt_SrvD( i), SrvD%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL SrvD_CopyInput (y_FAST%op%u_SrvD(i), SrvD%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + + + ! HydroDyn: copy op to actual states and inputs + IF ( p_FAST%CompHydro == Module_HD ) THEN + CALL HydroDyn_CopyContState (y_FAST%op%x_HD( i), HD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyDiscState (y_FAST%op%xd_HD( i), HD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyConstrState (y_FAST%op%z_HD( i), HD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL HydroDyn_CopyOtherState (y_FAST%op%OtherSt_HD( i), HD%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL HydroDyn_CopyInput (y_FAST%op%u_HD(i), HD%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + + + ! SubDyn: copy final predictions to actual states + IF ( p_FAST%CompSub == Module_SD ) THEN + CALL SD_CopyContState (y_FAST%op%x_SD(i), SD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyDiscState (y_FAST%op%xd_SD(i), SD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyConstrState( y_FAST%op%z_SD(i), SD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SD_CopyOtherState (y_FAST%op%OtherSt_SD(i), SD%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL SD_CopyInput (y_FAST%op%u_SD(i), SD%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ELSE IF ( p_FAST%CompSub == Module_ExtPtfm ) THEN + CALL ExtPtfm_CopyContState (y_FAST%op%x_ExtPtfm(i), ExtPtfm%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyDiscState (y_FAST%op%xd_ExtPtfm(i), ExtPtfm%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyConstrState (y_FAST%op%z_ExtPtfm(i), ExtPtfm%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ExtPtfm_CopyOtherState (y_FAST%op%OtherSt_ExtPtfm(i), ExtPtfm%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL ExtPtfm_CopyInput (y_FAST%op%u_ExtPtfm(i), ExtPtfm%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END IF + + + ! MAP/MoorDyn/FEAM: copy op to actual states and inputs + IF (p_FAST%CompMooring == Module_MAP) THEN + CALL MAP_CopyContState (y_FAST%op%x_MAP(i), MAPp%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MAP_CopyDiscState (y_FAST%op%xd_MAP(i), MAPp%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MAP_CopyConstrState (y_FAST%op%z_MAP(i), MAPp%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + !CALL MAP_CopyOtherState (y_FAST%op%OtherSt_MAP(i), MAPp%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + ! CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL MAP_CopyInput (y_FAST%op%u_MAP(i), MAPp%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ELSEIF (p_FAST%CompMooring == Module_MD) THEN + CALL MD_CopyContState (y_FAST%op%x_MD(i), MD%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyDiscState (y_FAST%op%xd_MD(i), MD%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyConstrState (y_FAST%op%z_MD(i), MD%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL MD_CopyOtherState (y_FAST%op%OtherSt_MD(i), MD%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL MD_CopyInput (y_FAST%op%u_MD(i), MD%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ELSEIF (p_FAST%CompMooring == Module_FEAM) THEN + CALL FEAM_CopyContState (y_FAST%op%x_FEAM(i), FEAM%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyDiscState (y_FAST%op%xd_FEAM(i), FEAM%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyConstrState (y_FAST%op%z_FEAM(i), FEAM%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL FEAM_CopyOtherState (y_FAST%op%OtherSt_FEAM(i), FEAM%OtherSt( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL FEAM_CopyInput (y_FAST%op%u_FEAM(i), FEAM%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + !ELSEIF (p_FAST%CompMooring == Module_Orca) THEN + END IF + + ! IceFloe/IceDyn: copy op to actual states and inputs + IF ( p_FAST%CompIce == Module_IceF ) THEN + CALL IceFloe_CopyContState (y_FAST%op%x_IceF(i), IceF%x( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyDiscState (y_FAST%op%xd_IceF(i), IceF%xd(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyConstrState (y_FAST%op%z_IceF(i), IceF%z( STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceFloe_CopyOtherState (y_FAST%op%OtherSt_IceF(i), IceF%OtherSt(STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL IceFloe_CopyInput (y_FAST%op%u_IceF(i), IceF%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + ELSEIF ( p_FAST%CompIce == Module_IceD ) THEN + DO k=1,p_FAST%numIceLegs + CALL IceD_CopyContState (y_FAST%op%x_IceD(k, i), IceD%x( k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyDiscState (y_FAST%op%xd_IceD(k, i), IceD%xd(k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyConstrState (y_FAST%op%z_IceD(k, i), IceD%z( k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL IceD_CopyOtherState (y_FAST%op%OtherSt_IceD(k, i), IceD%OtherSt( k,STATE_CURR), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL IceD_CopyInput (y_FAST%op%u_IceD(k, i), IceD%Input(1,k), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + END IF + +END SUBROUTINE SetOperatingPoint +!---------------------------------------------------------------------------------------------------------------------------------- +subroutine GetStateAry(p_FAST, iMode, t, x, x_eig_magnitude, x_eig_phase) + INTEGER(IntKi), INTENT(IN ) :: iMode !< index into Mode dimension of arrays + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + REAL(DbKi) , INTENT(IN ) :: t !< time + REAL(R8Ki), INTENT(INOUT) :: x(:) !< in: state at its operating point; out: added perturbation + REAL(R8Ki), INTENT(IN) :: x_eig_magnitude(:) !< magnitude of the eigenvector + REAL(R8Ki), INTENT(IN) :: x_eig_phase(:) !< phase of the eigenvector + + ! note that this assumes p_FAST%VTK_modes%VTKLinPhase is zero for VTKLinTim=2 + x = x + x_eig_magnitude * p_FAST%VTK_modes%VTKLinScale * cos( TwoPi_D * p_FAST%VTK_modes%DampedFreq_Hz(iMode)*t + x_eig_phase + p_FAST%VTK_modes%VTKLinPhase ) +end subroutine GetStateAry + + + +!---------------------------------------------------------------------------------------------------------------------------------- +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine performs the algorithm for computing a periodic steady-state solution. +SUBROUTINE FAST_CalcSteady( n_t_global, t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + IceF, IceD, ErrStat, ErrMsg ) + + INTEGER(IntKi), INTENT(IN ) :: n_t_global !< integer time step + REAL(DbKi), INTENT(IN ) :: t_global ! current simulation time + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data + TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpFM !< OpenFOAM data + TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data + TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm data + TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data + TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< Data for the MoorDyn module + TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data + TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data + TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop + + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! local variables + REAL(DbKi) :: DeltaAzim + REAL(DbKi) :: psi !< psi (rotor azimuth) at which the outputs are defined + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + LOGICAL :: NextAzimuth + + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CalcSteady' + + + ErrStat = ErrID_None + ErrMsg = "" + + + ! get azimuth angle + + psi = ED%y%LSSTipPxa + call Zero2TwoPi( psi ) + + if (n_t_global == 0) then + ! initialize a few things on the first call: + call FAST_InitSteadyOutputs( psi, p_FAST, m_FAST, ED, BD, SrvD, AD, IfW, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + IceF, IceD, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + else + DeltaAzim = psi - m_FAST%Lin%Psi(1) + call Zero2TwoPi(DeltaAzim) + + if (DeltaAzim > p_FAST%AzimDelta) then + call SetErrStat(ErrID_Fatal, "The rotor is spinning too fast. The time step or NLinTimes is too large when CalcSteady=true.", ErrStat, ErrMsg, RoutineName) + return + end if + + ! save the outputs and azimuth angle for possible interpolation later + call FAST_SaveOutputs( psi, p_FAST, m_FAST, ED, BD, SrvD, AD, IfW, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + IceF, IceD, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + end if + if (ErrStat >= AbortErrLev) return + + + + if ( m_FAST%Lin%AzimTarget(m_FAST%Lin%AzimIndx-1) <= m_FAST%Lin%AzimTarget(m_FAST%Lin%AzimIndx) ) then ! the equal sign takes care of the zero-rpm case + NextAzimuth = psi >= m_FAST%Lin%AzimTarget(m_FAST%Lin%AzimIndx) + else + ! this is the 2pi boundary, so we are either larger than the last target azimuth or less than the next one + NextAzimuth = psi >= m_FAST%Lin%AzimTarget(m_FAST%Lin%AzimIndx) .and. psi < m_FAST%Lin%AzimTarget(m_FAST%Lin%AzimIndx-1) + end if + + if (NextAzimuth) then + + ! interpolate to find y at the target azimuth + call FAST_DiffInterpOutputs( m_FAST%Lin%AzimTarget(m_FAST%Lin%AzimIndx), p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + IceF, IceD, ErrStat, ErrMsg ) + + if (m_FAST%Lin%IsConverged .or. m_FAST%Lin%n_rot == 0) then ! save this operating point for linearization later + m_FAST%Lin%LinTimes(m_FAST%Lin%AzimIndx) = t_global + call SaveOP(m_FAST%Lin%AzimIndx, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + IceF, IceD, ErrStat, ErrMsg, m_FAST%Lin%CopyOP_CtrlCode ) + end if + + ! increment the counter to check the next azimuth: + m_FAST%Lin%AzimIndx = m_FAST%Lin%AzimIndx + 1 + + ! check if we've completed one rotor revolution + if (m_FAST%Lin%AzimIndx > p_FAST%NLinTimes) then + m_FAST%Lin%n_rot = m_FAST%Lin%n_rot + 1 + + m_FAST%Lin%FoundSteady = m_FAST%Lin%IsConverged + + if (.not. m_FAST%Lin%FoundSteady) then + ! compute the reference values for this rotor revolution + call ComputeOutputRanges(p_FAST, y_FAST, m_FAST, SrvD%y) + m_FAST%Lin%IsConverged = .true. ! check errors next rotor revolution + m_FAST%Lin%AzimIndx = 1 + m_FAST%Lin%CopyOP_CtrlCode = MESH_UPDATECOPY + end if + end if + + end if + + +END SUBROUTINE FAST_CalcSteady +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine initializes variables for calculating periodic steady-state solution. +SUBROUTINE FAST_InitSteadyOutputs( psi, p_FAST, m_FAST, ED, BD, SrvD, AD, IfW, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + IceF, IceD, ErrStat, ErrMsg ) + + REAL(DbKi), INTENT(IN ) :: psi !< psi (rotor azimuth) at which the outputs are defined + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data + TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data + TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm data + TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data + TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< Data for the MoorDyn module + TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data + TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data + TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop + + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! local variables + INTEGER(IntKi) :: j, k ! loop counters + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_InitSteadyOutputs' + + + ErrStat = ErrID_None + ErrMsg = "" + + do j=1,p_FAST%NLinTimes + m_FAST%Lin%AzimTarget(j) = (j-1) * p_FAST%AzimDelta + psi + call Zero2TwoPi( m_FAST%Lin%AzimTarget(j) ) + end do + ! this is circular, so I am going to add points at the beginning and end to avoid + ! more IF statements later + m_FAST%Lin%AzimTarget(0) = m_FAST%Lin%AzimTarget(p_FAST%NLinTimes) + m_FAST%Lin%AzimTarget(p_FAST%NLinTimes+1) = m_FAST%Lin%AzimTarget(1) + + + ! Azimuth angles that correspond to Output arrays for interpolation: + !m_FAST%Lin%Psi = psi ! initialize entire array (note that we won't be able to interpolate with a constant array + DO j = 1, p_FAST%LinInterpOrder + 1 + m_FAST%Lin%Psi(j) = psi - (j - 1) * D2R_D ! arbitrarily say azimuth is one degree different + END DO + + + ! ElastoDyn + allocate( ED%Output( p_FAST%LinInterpOrder+1 ), STAT = ErrStat2 ) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating ED%Output.", ErrStat, ErrMsg, RoutineName ) + else + do j = 1, p_FAST%LinInterpOrder + 1 + call ED_CopyOutput(ED%y, ED%Output(j), MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end do + + call ED_CopyOutput(ED%y, ED%y_interp, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end if + + ! BeamDyn + IF (p_FAST%CompElast == Module_BD) THEN + + allocate( BD%Output( p_FAST%LinInterpOrder+1, p_FAST%nBeams ), STAT = ErrStat2 ) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating BD%Output.", ErrStat, ErrMsg, RoutineName ) + else + do k=1,p_FAST%nBeams + do j = 1, p_FAST%LinInterpOrder + 1 + call BD_CopyOutput(BD%y(k), BD%Output(j,k), MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end do + end do + + allocate( BD%y_interp( p_FAST%nBeams ), STAT = ErrStat2 ) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating BD%Output.", ErrStat, ErrMsg, RoutineName ) + else + do k=1,p_FAST%nBeams + call BD_CopyOutput(BD%y(k), BD%y_interp(k), MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end do + end if + + end if + + END IF ! BeamDyn + + ! AeroDyn + IF ( p_FAST%CompAero == Module_AD ) THEN + + allocate( AD%Output( p_FAST%LinInterpOrder+1 ), STAT = ErrStat2 ) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating AD%Output.", ErrStat, ErrMsg, RoutineName ) + else + do j = 1, p_FAST%LinInterpOrder + 1 + call AD_CopyOutput(AD%y, AD%Output(j), MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end do + + call AD_CopyOutput(AD%y, AD%y_interp, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end if + + END IF ! CompAero + + + ! InflowWind + IF ( p_FAST%CompInflow == Module_IfW ) THEN + + allocate( IfW%Output( p_FAST%LinInterpOrder+1 ), STAT = ErrStat2 ) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating IfW%Output.", ErrStat, ErrMsg, RoutineName ) + else + do j = 1, p_FAST%LinInterpOrder + 1 + call InflowWind_CopyOutput(IfW%y, IfW%Output(j), MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end do + + call InflowWind_CopyOutput(IfW%y, IfW%y_interp, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end if + + END IF ! CompInflow + + + ! ServoDyn + IF ( p_FAST%CompServo == Module_SrvD ) THEN + + allocate( SrvD%Output( p_FAST%LinInterpOrder+1 ), STAT = ErrStat2 ) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating SrvD%Output.", ErrStat, ErrMsg, RoutineName ) + else + do j = 1, p_FAST%LinInterpOrder + 1 + call SrvD_CopyOutput(SrvD%y, SrvD%Output(j), MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end do + + call SrvD_CopyOutput(SrvD%y, SrvD%y_interp, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end if + + END IF ! ServoDyn + + ! HydroDyn + IF ( p_FAST%CompHydro == Module_HD ) THEN + + allocate( HD%Output( p_FAST%LinInterpOrder+1 ), STAT = ErrStat2 ) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating HD%Output.", ErrStat, ErrMsg, RoutineName ) + else + do j = 1, p_FAST%LinInterpOrder + 1 + call HydroDyn_CopyOutput(HD%y, HD%Output(j), MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end do + + call HydroDyn_CopyOutput(HD%y, HD%y_interp, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end if + + END IF ! HydroDyn + + + !! SubDyn/ExtPtfm_MCKF + !IF ( p_FAST%CompSub == Module_SD ) THEN + !ELSE IF ( p_FAST%CompSub == Module_ExtPtfm ) THEN + !END IF ! SubDyn/ExtPtfm_MCKF + + + ! Mooring (MAP , FEAM , MoorDyn) + ! MAP + IF ( p_FAST%CompMooring == Module_MAP ) THEN + + allocate( MAPp%Output( p_FAST%LinInterpOrder+1 ), STAT = ErrStat2 ) + if (ErrStat2 /= 0) then + call SetErrStat(ErrID_Fatal, "Error allocating MAPp%Output.", ErrStat, ErrMsg, RoutineName ) + else + do j = 1, p_FAST%LinInterpOrder + 1 + call MAP_CopyOutput(MAPp%y, MAPp%Output(j), MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end do + + call MAP_CopyOutput(MAPp%y, MAPp%y_interp, MESH_NEWCOPY, ErrStat2, ErrMsg2) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + end if + + !! MoorDyn + !ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN + !! FEAM + !ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN + !! OrcaFlex + !ELSEIF ( p_FAST%CompMooring == Module_Orca ) THEN + + END IF ! MAP/FEAM/MoorDyn/OrcaFlex + + + + !! Ice (IceFloe or IceDyn) + !! IceFloe + !IF ( p_FAST%CompIce == Module_IceF ) THEN + ! + !! IceDyn + !ELSEIF ( p_FAST%CompIce == Module_IceD ) THEN + ! + !END IF ! IceFloe/IceDyn + + +END SUBROUTINE FAST_InitSteadyOutputs +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine saves outputs for future interpolation at a desired azimuth. +SUBROUTINE FAST_SaveOutputs( psi, p_FAST, m_FAST, ED, BD, SrvD, AD, IfW, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + IceF, IceD, ErrStat, ErrMsg ) + + REAL(DbKi), INTENT(IN ) :: psi !< psi (rotor azimuth) at which the outputs are defined + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data + TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data + TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm data + TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data + TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< Data for the MoorDyn module + TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data + TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data + TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop + + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! local variables + INTEGER(IntKi) :: j, k ! loop counters + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_SaveOutputs' + + + ErrStat = ErrID_None + ErrMsg = "" + + DO j = p_FAST%LinInterpOrder, 1, -1 + m_FAST%Lin%Psi(j+1) = m_FAST%Lin%Psi(j) + END DO + + if (psi < m_FAST%Lin%Psi(1)) then + ! if we go around a 2pi boundary, we will subtract 2pi from the saved values so that interpolation works as expected + m_FAST%Lin%Psi = m_FAST%Lin%Psi - TwoPi_D + end if + m_FAST%Lin%Psi(1) = psi + + ! ElastoDyn + DO j = p_FAST%LinInterpOrder, 1, -1 + CALL ED_CopyOutput(ED%Output(j), ED%Output(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + END DO + + CALL ED_CopyOutput (ED%y, ED%Output(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + ! BeamDyn + IF (p_FAST%CompElast == Module_BD) THEN + + DO k = 1,p_FAST%nBeams + + DO j = p_FAST%LinInterpOrder, 1, -1 + CALL BD_CopyOutput (BD%Output(j,k), BD%Output(j+1,k), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + END DO + + CALL BD_CopyOutput (BD%y(k), BD%Output(1,k), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + END DO ! k=p_FAST%nBeams + + END IF ! BeamDyn + + + ! AeroDyn + IF ( p_FAST%CompAero == Module_AD ) THEN + + DO j = p_FAST%LinInterpOrder, 1, -1 + CALL AD_CopyOutput (AD%Output(j), AD%Output(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + END DO + + CALL AD_CopyOutput (AD%y, AD%Output(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + END IF ! CompAero + + + ! InflowWind + IF ( p_FAST%CompInflow == Module_IfW ) THEN + + DO j = p_FAST%LinInterpOrder, 1, -1 + CALL InflowWind_CopyOutput (IfW%Output(j), IfW%Output(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + END DO + + CALL InflowWind_CopyOutput (IfW%y, IfW%Output(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + END IF ! CompInflow + + + ! ServoDyn + IF ( p_FAST%CompServo == Module_SrvD ) THEN + + DO j = p_FAST%LinInterpOrder, 1, -1 + CALL SrvD_CopyOutput (SrvD%Output(j), SrvD%Output(j+1), MESH_UPDATECOPY, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + END DO + + CALL SrvD_CopyOutput (SrvD%y, SrvD%Output(1), MESH_UPDATECOPY, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + END IF ! ServoDyn + + ! HydroDyn + IF ( p_FAST%CompHydro == Module_HD ) THEN + + DO j = p_FAST%LinInterpOrder, 1, -1 + + CALL HydroDyn_CopyOutput (HD%Output(j), HD%Output(j+1), MESH_UPDATECOPY, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + END DO + + CALL HydroDyn_CopyOutput (HD%y, HD%Output(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + END IF ! HydroDyn + + + !! SubDyn/ExtPtfm_MCKF + !IF ( p_FAST%CompSub == Module_SD ) THEN + !ELSE IF ( p_FAST%CompSub == Module_ExtPtfm ) THEN + !END IF ! SubDyn/ExtPtfm_MCKF + + + ! Mooring (MAP , FEAM , MoorDyn) + ! MAP + IF ( p_FAST%CompMooring == Module_MAP ) THEN + + DO j = p_FAST%LinInterpOrder, 1, -1 + CALL MAP_CopyOutput (MAPp%Output(j), MAPp%Output(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + END DO + + CALL MAP_CopyOutput (MAPp%y, MAPp%Output(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + !! MoorDyn + !ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN + !! FEAM + !ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN + !! OrcaFlex + !ELSEIF ( p_FAST%CompMooring == Module_Orca ) THEN + + END IF ! MAP/FEAM/MoorDyn/OrcaFlex + + + + !! Ice (IceFloe or IceDyn) + !! IceFloe + !IF ( p_FAST%CompIce == Module_IceF ) THEN + ! + !! IceDyn + !ELSEIF ( p_FAST%CompIce == Module_IceD ) THEN + ! + !END IF ! IceFloe/IceDyn + + +END SUBROUTINE FAST_SaveOutputs +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine interpolates the outputs at the target azimuths, computes the compared to the previous rotation, and stores +!! them for future rotation . +SUBROUTINE FAST_DiffInterpOutputs( psi_target, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + IceF, IceD, ErrStat, ErrMsg ) + + REAL(DbKi), INTENT(IN ) :: psi_target !< psi (rotor azimuth) at which the outputs are requested + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data + TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data + TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm data + TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data + TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< Data for the MoorDyn module + TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data + TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data + TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop + + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! local variables + INTEGER(IntKi) :: k ! loop counters + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + REAL(DbKi) :: t_global + REAL(ReKi) :: eps_squared + + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DiffInterpOutputs' + + ErrStat = ErrID_None + ErrMsg = "" + t_global = 0.0_DbKi ! we don't really need this to get the output OPs + + !................................................................................................ + ! Extrapolate outputs to the target azimuth and pack into OP arrays + !................................................................................................ + + ! ElastoDyn + CALL ED_Output_ExtrapInterp (ED%Output, m_FAST%Lin%Psi, ED%y_interp, psi_target, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + call ED_GetOP( t_global, ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), & + ED%y_interp, ED%m, ErrStat2, ErrMsg2, y_op=y_FAST%Lin%Modules(Module_ED)%Instance(1)%op_y, NeedLogMap=.true.) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + + ! BeamDyn + IF (p_FAST%CompElast == Module_BD) THEN + + DO k = 1,p_FAST%nBeams + + CALL BD_Output_ExtrapInterp (BD%Output(:,k), m_FAST%Lin%Psi, BD%y_interp(k), psi_target, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + call BD_GetOP( t_global, BD%Input(1,k), BD%p(k), BD%x(k,STATE_CURR), BD%xd(k,STATE_CURR), BD%z(k,STATE_CURR), BD%OtherSt(k,STATE_CURR), & + BD%y_interp(k), BD%m(k), ErrStat2, ErrMsg2, y_op=y_FAST%Lin%Modules(Module_BD)%Instance(k)%op_y, NeedLogMap=.true.) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + END DO ! k=p_FAST%nBeams + + END IF ! BeamDyn + + + ! AeroDyn + IF ( p_FAST%CompAero == Module_AD ) THEN + + CALL AD_Output_ExtrapInterp (AD%Output, m_FAST%Lin%Psi, AD%y_interp, psi_target, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + call AD_GetOP( t_global, AD%Input(1), AD%p, AD%x(STATE_CURR), AD%xd(STATE_CURR), AD%z(STATE_CURR), AD%OtherSt(STATE_CURR), & + AD%y_interp, AD%m, ErrStat2, ErrMsg2, y_op=y_FAST%Lin%Modules(Module_AD)%Instance(1)%op_y) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + END IF ! CompAero + + + ! InflowWind + IF ( p_FAST%CompInflow == Module_IfW ) THEN + + CALL InflowWind_Output_ExtrapInterp (IfW%Output, m_FAST%Lin%Psi, IfW%y_interp, psi_target, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + call InflowWind_GetOP( t_global, IfW%Input(1), IfW%p, IfW%x(STATE_CURR), IfW%xd(STATE_CURR), IfW%z(STATE_CURR), IfW%OtherSt(STATE_CURR), & + IfW%y_interp, IfW%m, ErrStat2, ErrMsg2, y_op=y_FAST%Lin%Modules(Module_IfW)%Instance(1)%op_y) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + END IF ! CompInflow + + + ! ServoDyn + IF ( p_FAST%CompServo == Module_SrvD ) THEN + + CALL SrvD_Output_ExtrapInterp (SrvD%Output, m_FAST%Lin%Psi, SrvD%y_interp, psi_target, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + call SrvD_GetOP( t_global, SrvD%Input(1), SrvD%p, SrvD%x(STATE_CURR), SrvD%xd(STATE_CURR), SrvD%z(STATE_CURR), SrvD%OtherSt(STATE_CURR), & + SrvD%y_interp, SrvD%m, ErrStat2, ErrMsg2, y_op=y_FAST%Lin%Modules(Module_SrvD)%Instance(1)%op_y) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + END IF ! ServoDyn + + ! HydroDyn + IF ( p_FAST%CompHydro == Module_HD ) THEN + + CALL HydroDyn_Output_ExtrapInterp (HD%Output, m_FAST%Lin%Psi, HD%y_interp, psi_target, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + call HD_GetOP( t_global, HD%Input(1), HD%p, HD%x(STATE_CURR), HD%xd(STATE_CURR), HD%z(STATE_CURR), HD%OtherSt(STATE_CURR), & + HD%y_interp, HD%m, ErrStat2, ErrMsg2, y_op=y_FAST%Lin%Modules(Module_HD)%Instance(1)%op_y) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + END IF ! HydroDyn + + + !! SubDyn/ExtPtfm_MCKF + !IF ( p_FAST%CompSub == Module_SD ) THEN + !ELSE IF ( p_FAST%CompSub == Module_ExtPtfm ) THEN + !END IF ! SubDyn/ExtPtfm_MCKF + + + ! Mooring (MAP , FEAM , MoorDyn) + ! MAP + IF ( p_FAST%CompMooring == Module_MAP ) THEN + + CALL MAP_Output_ExtrapInterp (MAPp%Output, m_FAST%Lin%Psi, MAPp%y_interp, psi_target, ErrStat2, ErrMsg2) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) + + call MAP_GetOP( t_global, MAPp%Input(1), MAPp%p, MAPp%x(STATE_CURR), MAPp%xd(STATE_CURR), MAPp%z(STATE_CURR), MAPp%OtherSt, & + MAPp%y_interp, ErrStat2, ErrMsg2, y_op=y_FAST%Lin%Modules(Module_MAP)%Instance(1)%op_y) + call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) + !! MoorDyn + !ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN + !! FEAM + !ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN + !! OrcaFlex + !ELSEIF ( p_FAST%CompMooring == Module_Orca ) THEN + + END IF ! MAP/FEAM/MoorDyn/OrcaFlex + + + + !! Ice (IceFloe or IceDyn) + !! IceFloe + !IF ( p_FAST%CompIce == Module_IceF ) THEN + ! + !! IceDyn + !ELSEIF ( p_FAST%CompIce == Module_IceD ) THEN + ! + !END IF ! IceFloe/IceDyn + + + call pack_in_array(p_FAST, y_FAST, m_FAST) + + if (m_FAST%Lin%IsConverged) then + ! check that error equation is less than TrimTol !!!call + call calc_error(p_FAST, y_FAST, m_FAST, SrvD%y, eps_squared) + m_FAST%Lin%IsConverged = eps_squared < p_FAST%TrimTol + end if + + + m_FAST%Lin%Y_prevRot(:,m_FAST%Lin%AzimIndx) = m_FAST%Lin%y_interp + +END SUBROUTINE FAST_DiffInterpOutputs +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE pack_in_array(p_FAST, y_FAST, m_FAST) + + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + + INTEGER(IntKi) :: ThisModule !< module identifier + INTEGER(IntKi) :: ThisInstance !< index of the module instance + + integer :: i, j + integer :: ny + integer :: indx + + ! note that op_y may be larger than SizeLin if there are orientations; also, we are NOT including the WriteOutputs + + do i = 1,p_FAST%Lin_NumMods + ThisModule = p_FAST%Lin_ModOrder( i ) + + do ThisInstance=1,size(y_FAST%Lin%Modules(ThisModule)%Instance) + + ny = y_FAST%Lin%Modules(ThisModule)%Instance(ThisInstance)%SizeLin(LIN_OUTPUT_COL) - y_FAST%Lin%Modules(ThisModule)%Instance(ThisInstance)%NumOutputs !last column before WriteOutput occurs + do j=1,ny + indx = y_FAST%Lin%Modules(ThisModule)%Instance(ThisInstance)%LinStartIndx(LIN_OUTPUT_COL) + j - 1 + + m_FAST%Lin%y_interp( indx ) = y_FAST%Lin%Modules(ThisModule)%Instance(ThisInstance)%op_y(j) + end do + + end do + end do + +END SUBROUTINE pack_in_array +!---------------------------------------------------------------------------------------------------------------------------------- +!> This function computes the error function between this rotor revolution and the previous one. +!! Angles represented in m_FAST%Lin%y_interp may have 2pi added or subtracted to allow the angles to be closer to the previous +!! rotor revolution. +SUBROUTINE calc_error(p_FAST, y_FAST, m_FAST, y_SrvD, eps_squared) + + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + TYPE(FAST_OutputFileType),INTENT(IN ) :: y_FAST !< Output variables for the glue code + TYPE(SrvD_OutputType), INTENT(IN ) :: y_SrvD !< Output variables for the glue code + REAL(ReKi) ,INTENT( OUT) :: eps_squared !< epsilon squared + + INTEGER(IntKi) :: ThisModule !< module identifier + INTEGER(IntKi) :: ThisInstance !< index of the module instance + + integer :: i, j + integer :: ny + integer :: indx + real(ReKi) :: diff + + + ! special cases for angles: + indx = Indx_y_Yaw_Start(y_FAST, Module_ED) ! start of ED where Yaw, YawRate, HSS_Spd occur (right before WriteOutputs) + call AddOrSub2Pi(m_FAST%Lin%Y_prevRot( indx, m_FAST%Lin%AzimIndx ), m_FAST%Lin%y_interp( indx )) + + if (p_FAST%CompServo == Module_SrvD) then + do i = 1, size( y_SrvD%BlPitchCom ) + indx = y_FAST%Lin%Modules(Module_SrvD)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + i - 1 + call AddOrSub2Pi(m_FAST%Lin%Y_prevRot( indx, m_FAST%Lin%AzimIndx ), m_FAST%Lin%y_interp( indx )) + end do + end if + + + ! compute the error: + eps_squared = 0.0_ReKi + + do i = 1,p_FAST%Lin_NumMods + ThisModule = p_FAST%Lin_ModOrder( i ) + + do ThisInstance=1,size(y_FAST%Lin%Modules(ThisModule)%Instance) + + ny = y_FAST%Lin%Modules(ThisModule)%Instance(ThisInstance)%SizeLin(LIN_OUTPUT_COL) - y_FAST%Lin%Modules(ThisModule)%Instance(ThisInstance)%NumOutputs !last column before WriteOutput occurs + + do j=1,ny + indx = y_FAST%Lin%Modules(ThisModule)%Instance(ThisInstance)%LinStartIndx(LIN_OUTPUT_COL) + j - 1 + + if (EqualRealNos(m_FAST%Lin%y_interp( indx ), m_FAST%Lin%Y_prevRot( indx, m_FAST%Lin%AzimIndx ))) then + diff = 0.0_ReKi ! take care of some potential numerical issues + else + diff = m_FAST%Lin%y_interp( indx ) - m_FAST%Lin%Y_prevRot( indx, m_FAST%Lin%AzimIndx ) + end if + + eps_squared = eps_squared + ( diff / m_FAST%Lin%y_ref( indx ) ) ** 2 + end do + + end do + end do + + + !................................. + ! Normalize: + !................................. + eps_squared = eps_squared / ( y_FAST%Lin%Glue%SizeLin(LIN_OUTPUT_COL) - y_FAST%Lin%Glue%NumOutputs ) + +! write(50+m_FAST%Lin%AzimIndx,'(3000(F15.7,1x))') m_FAST%Lin%y_interp, eps_squared +END SUBROUTINE calc_error +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE ComputeOutputRanges(p_FAST, y_FAST, m_FAST, y_SrvD) + + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + TYPE(FAST_OutputFileType),INTENT(IN ) :: y_FAST !< Output variables for the glue code + TYPE(SrvD_OutputType), INTENT(IN ) :: y_SrvD !< Output variables for the glue code + + integer :: indx + integer :: i + + ! note that op_y may be larger than SizeLin if there are orientations; also, we are NOT including the WriteOutputs + + do indx = 1,y_FAST%Lin%Glue%SizeLin(LIN_OUTPUT_COL) + m_FAST%Lin%y_ref(indx) = maxval( m_FAST%Lin%Y_prevRot( indx, : ) ) - minval( m_FAST%Lin%Y_prevRot( indx, : ) ) + m_FAST%Lin%y_ref(indx) = max( m_FAST%Lin%y_ref(indx), 0.01_ReKi ) +! if (m_FAST%Lin%y_ref(indx) < 1.0e-4) m_FAST%Lin%y_ref(indx) = 1.0_ReKi ! not sure why we wouldn't just do m_FAST%Lin%y_ref(indx) = max(1.0_ReKi, m_FAST%Lin%y_ref(indx)) or max(1e-4, y_ref(indx)) + end do + + ! special case for angles: + indx = Indx_y_Yaw_Start(y_FAST, Module_ED) ! start of ED where Yaw, YawRate, HSS_Spd occur (right before WriteOutputs) + m_FAST%Lin%y_ref(indx) = min( m_FAST%Lin%y_ref(indx), Pi ) + + if (p_FAST%CompServo == Module_SrvD) then + do i = 1, size( y_SrvD%BlPitchCom ) + indx = y_FAST%Lin%Modules(Module_SrvD)%Instance(1)%LinStartIndx(LIN_OUTPUT_COL) + i - 1 + m_FAST%Lin%y_ref(indx) = min( m_FAST%Lin%y_ref(indx), Pi ) + end do + end if + + ! Note: I'm ignoring the periodicity of the log maps that represent orientations + +END SUBROUTINE ComputeOutputRanges +!---------------------------------------------------------------------------------------------------------------------------------- + END MODULE FAST_Linear diff --git a/modules/openfast-library/src/FAST_Mods.f90 b/modules/openfast-library/src/FAST_Mods.f90 index 2d5e1bffb3..f528ae815d 100644 --- a/modules/openfast-library/src/FAST_Mods.f90 +++ b/modules/openfast-library/src/FAST_Mods.f90 @@ -42,6 +42,7 @@ MODULE FAST_ModTypes INTEGER(IntKi), PARAMETER :: VTK_None = 0 !< none (no VTK output) INTEGER(IntKi), PARAMETER :: VTK_InitOnly = 1 !< VTK output only at initialization INTEGER(IntKi), PARAMETER :: VTK_Animate = 2 !< VTK animation output + INTEGER(IntKi), PARAMETER :: VTK_ModeShapes = 3 !< VTK output after linearization analysis INTEGER(IntKi), PARAMETER :: VTK_Surf = 1 !< output surfaces INTEGER(IntKi), PARAMETER :: VTK_Basic = 2 !< output minimal number of point/line meshes diff --git a/modules/openfast-library/src/FAST_Registry.txt b/modules/openfast-library/src/FAST_Registry.txt index 40d766bed1..d599f93262 100644 --- a/modules/openfast-library/src/FAST_Registry.txt +++ b/modules/openfast-library/src/FAST_Registry.txt @@ -70,6 +70,22 @@ typedef ^ FAST_VTK_SurfaceType SiKi WaveElev {:}{:} - - "wave elevation at WaveE typedef ^ FAST_VTK_SurfaceType FAST_VTK_BLSurfaceType BladeShape {:} - - "AirfoilCoords for each blade" m typedef ^ FAST_VTK_SurfaceType SiKi MorisonRad {:} - - "radius of each Morison node" m + +typedef ^ FAST_VTK_ModeShapeType CHARACTER(1024) CheckpointRoot - - - "name of the checkpoint file written by FAST when linearization data was produced" +typedef ^ FAST_VTK_ModeShapeType CHARACTER(1024) MatlabFileName - - - "name of the file with eigenvectors written by Matlab" +typedef ^ FAST_VTK_ModeShapeType IntKi VTKLinModes - - - "Number of modes to visualize" - +typedef ^ FAST_VTK_ModeShapeType IntKi VTKModes {:} - - "Which modes to visualize" - +typedef ^ FAST_VTK_ModeShapeType IntKi VTKLinTim - - - "Switch to make one animation for all LinTimes together (1) or separate animations for each LinTimes(2)" - +typedef ^ FAST_VTK_ModeShapeType IntKi VTKNLinTimes - - - "number of linearization times to use when VTKLinTim==2" - +typedef ^ FAST_VTK_ModeShapeType ReKi VTKLinScale - - - "Mode shape visualization scaling factor" - +typedef ^ FAST_VTK_ModeShapeType ReKi VTKLinPhase - - - "Phase when making one animation for all LinTimes together (used only when VTKLinTim=1)" - +typedef ^ FAST_VTK_ModeShapeType R8Ki DampingRatio {:} - - "damping ratios from mbc3 analysis" - +typedef ^ FAST_VTK_ModeShapeType R8Ki NaturalFreq_Hz {:} - - "natural frequency from mbc3 analysis" - +typedef ^ FAST_VTK_ModeShapeType R8Ki DampedFreq_Hz {:} - - "damped frequency from mbc3 analysis" - +typedef ^ FAST_VTK_ModeShapeType R8Ki x_eig_magnitude {:}{:}{:} - - "magnitude of eigenvector (dimension 1=state, dim 2= azimuth, dim 3 = mode)" - +typedef ^ FAST_VTK_ModeShapeType R8Ki x_eig_phase {:}{:}{:} - - "phase of eigenvector (dimension 1=state, dim 2= azimuth, dim 3 = mode)" - + + # ..... FAST_ParameterType data ....................................................................................................... # Misc data for coupling: typedef FAST FAST_ParameterType DbKi DT - - - "Integration time step [global time]" s @@ -116,13 +132,14 @@ typedef ^ FAST_ParameterType DbKi DT_Out - - - "Time step for tabular output" s typedef ^ FAST_ParameterType LOGICAL WrSttsTime - - - "Whether we should write the status times to the screen" - typedef ^ FAST_ParameterType INTEGER n_SttsTime - - - "Number of time steps between screen status messages" - typedef ^ FAST_ParameterType INTEGER n_ChkptTime - - - "Number of time steps between writing checkpoint files" - +typedef ^ FAST_ParameterType INTEGER n_DT_Out - - - "Number of time steps between writing a line in the time-marching output files" - typedef ^ FAST_ParameterType INTEGER n_VTKTime - - - "Number of time steps between writing VTK files" - typedef ^ FAST_ParameterType IntKi TurbineType - - - "Type_LandBased, Type_Offshore_Fixed, or Type_Offshore_Floating" - typedef ^ FAST_ParameterType LOGICAL WrBinOutFile - - - "Write a binary output file? (.outb)" - typedef ^ FAST_ParameterType LOGICAL WrTxtOutFile - - - "Write a text (formatted) output file? (.out)" - typedef ^ FAST_ParameterType IntKi WrBinMod - - - "If writing binary, which file format is to be written [1, 2, or 3]" - typedef ^ FAST_ParameterType LOGICAL SumPrint - - - "Print summary data to file? (.sum)" - -typedef ^ FAST_ParameterType INTEGER WrVTK - - - "VTK Visualization data output: (switch) {0=none; 1=initialization data only; 2=animation}" - +typedef ^ FAST_ParameterType INTEGER WrVTK - 0 - "VTK Visualization data output: (switch) {0=none; 1=initialization data only; 2=animation}" - typedef ^ FAST_ParameterType INTEGER VTK_Type - - - "Type of VTK visualization data: (switch) {1=surfaces; 2=basic meshes (lines/points); 3=all meshes (debug)}" - typedef ^ FAST_ParameterType LOGICAL VTK_fields - - - "Write mesh fields to VTK data files? (flag) {true/false}" - typedef ^ FAST_ParameterType CHARACTER(1) Delim - - - "Delimiter between columns of text output file (.out): space or tab" - @@ -132,17 +149,117 @@ typedef ^ FAST_ParameterType IntKi FmtWidth - - - "width of the time OutFmt spec typedef ^ FAST_ParameterType IntKi TChanLen - - - "width of the time channel" - typedef ^ FAST_ParameterType CHARACTER(1024) OutFileRoot - - - "The rootname of the output files" - typedef ^ FAST_ParameterType CHARACTER(1024) FTitle - - - "The description line from the FAST (glue-code) input file" - -typedef ^ FAST_ParameterType DbKi LinTimes {:} - - "List of times at which to linearize" s +typedef ^ FAST_ParameterType CHARACTER(1024) VTK_OutFileRoot - "''" - "The rootname of the VTK output files" - +typedef ^ FAST_ParameterType INTEGER VTK_tWidth - - - "Width of number of files for leading zeros in file name format" - +typedef ^ FAST_ParameterType DbKi VTK_fps - - - "number of frames per second to output VTK data" - +typedef ^ FAST_ParameterType FAST_VTK_SurfaceType VTK_surface - - - "Data for VTK surface visualization" +typedef ^ FAST_ParameterType SiKi TurbinePos {3} - - "Initial position of turbine base (origin used for graphics)" m +typedef ^ FAST_ParameterType CHARACTER(4) Tdesc - - - "description of turbine ID (for FAST.Farm) screen printing" + +# Parameters for linearization +typedef ^ FAST_ParameterType LOGICAL CalcSteady - - - "Calculate a steady-state periodic operating point before linearization [unused if Linearize=False]" - +typedef ^ FAST_ParameterType IntKi TrimCase - - - "Controller parameter to be trimmed {1:yaw; 2:torque; 3:pitch} [unused if Linearize=False; used only if CalcSteady=True]" - +typedef ^ FAST_ParameterType ReKi TrimTol - - - "Tolerance for the rotational speed convergence (>0) [unused if Linearize=False; used only if CalcSteady=True]" - +typedef ^ FAST_ParameterType ReKi TrimGain - - - "Proportional gain for the rotational speed error (>0) [unused if Linearize=False; used only if CalcSteady=True]" "rad/(rad/s) for yaw or pitch; Nm/(rad/s) for torque" +typedef ^ FAST_ParameterType ReKi Twr_Kdmp - - - "Damping factor for the tower [unused if Linearize=False; used only if CalcSteady=True]" "N/(m/s)" +typedef ^ FAST_ParameterType ReKi Bld_Kdmp - - - "Damping factor for the blades [unused if Linearize=False; used only if CalcSteady=True]" "N/(m/s)" +typedef ^ FAST_ParameterType IntKi NLinTimes - - - "Number of LinTimes, or equally-spaced azimuth steps in periodic linearized model (>0)[unused if Linearize=False]" - +typedef ^ FAST_ParameterType DbKi AzimDelta - - - "difference between two consecutive azimuth positions in CalcSteady algorithm" rad + typedef ^ FAST_ParameterType IntKi LinInputs - - - "Inputs included in linearization (switch) {0=none; 1=standard; 2=all module inputs (debug)} [unused if Linearize=False]" - typedef ^ FAST_ParameterType IntKi LinOutputs - - - "Outputs included in linearization (switch) {0=none; 1=from OutList(s); 2=all module outputs (debug)} [unused if Linearize=False]" - typedef ^ FAST_ParameterType LOGICAL LinOutJac - - - "Include full Jacabians in linearization output (for debug) (flag) [unused if Linearize=False; used only if LinInputs=LinOutputs=2]" - typedef ^ FAST_ParameterType LOGICAL LinOutMod - - - "Write module-level linearization output files in addition to output for full system? (flag) [unused if Linearize=False]" - -typedef ^ FAST_ParameterType FAST_VTK_SurfaceType VTK_surface - - - "Data for VTK surface visualization" -typedef ^ FAST_ParameterType SiKi TurbinePos {3} - - "Initial position of turbine base (origin used for graphics)" m +typedef ^ FAST_ParameterType FAST_VTK_ModeShapeType VTK_modes - - - "Data for VTK mode-shape visualization" typedef ^ FAST_ParameterType IntKi Lin_NumMods - - - "number of modules in the linearization" -typedef ^ FAST_ParameterType Integer Lin_ModOrder {NumModules} - - "indices that determine which order the modules are in the glue-code linearization matrix" -typedef ^ FAST_ParameterType CHARACTER(4) Tdesc - - - "description of turbine ID (for FAST.Farm) screen printing" +typedef ^ FAST_ParameterType IntKi Lin_ModOrder {NumModules} - - "indices that determine which order the modules are in the glue-code linearization matrix" +typedef ^ FAST_ParameterType IntKi LinInterpOrder - - - "Interpolation order for CalcSteady solution" - +#typedef ^ FAST_ParameterType LOGICAL CheckHSSBrTrqC - - - "Flag to determine if we should check HSSBrTrqC extrapolation to ElastoDyn" - + + +# SAVED OPERATING POINT DATA FOR VTKLIN (visualization of mode shapes from linearization analysis) +# ..... IceDyn OP data ....................................................................................................... +typedef FAST FAST_LinStateSave IceD_ContinuousStateType x_IceD {:}{:} - - "Continuous states" +typedef ^ ^ IceD_DiscreteStateType xd_IceD {:}{:} - - "Discrete states" +typedef ^ ^ IceD_ConstraintStateType z_IceD {:}{:} - - "Constraint states" +typedef ^ ^ IceD_OtherStateType OtherSt_IceD {:}{:} - - "Other states" +typedef ^ ^ IceD_InputType u_IceD {:}{:} - - "System inputs" +# ..... BeamDyn OP data ....................................................................................................... +typedef FAST FAST_LinStateSave BD_ContinuousStateType x_BD {:}{:} - - "Continuous states" +typedef ^ ^ BD_DiscreteStateType xd_BD {:}{:} - - "Discrete states" +typedef ^ ^ BD_ConstraintStateType z_BD {:}{:} - - "Constraint states" +typedef ^ ^ BD_OtherStateType OtherSt_BD {:}{:} - - "Other states" +typedef ^ ^ BD_InputType u_BD {:}{:} - - "System inputs" +# ..... ElastoDyn OP data ..................................................................................................... +typedef FAST FAST_LinStateSave ED_ContinuousStateType x_ED {:} - - "Continuous states" +typedef ^ ^ ED_DiscreteStateType xd_ED {:} - - "Discrete states" +typedef ^ ^ ED_ConstraintStateType z_ED {:} - - "Constraint states" +typedef ^ ^ ED_OtherStateType OtherSt_ED {:} - - "Other states" +typedef ^ ^ ED_InputType u_ED {:} - - "System inputs" +# ..... ServoDyn OP data ....................................................................................................... +typedef FAST FAST_LinStateSave SrvD_ContinuousStateType x_SrvD {:} - - "Continuous states" +typedef ^ ^ SrvD_DiscreteStateType xd_SrvD {:} - - "Discrete states" +typedef ^ ^ SrvD_ConstraintStateType z_SrvD {:} - - "Constraint states" +typedef ^ ^ SrvD_OtherStateType OtherSt_SrvD {:} - - "Other states" +typedef ^ ^ SrvD_InputType u_SrvD {:} - - "System inputs" +# ..... No AeroDyn14 data ..................................................................................................... +# ..... AeroDyn OP data ....................................................................................................... +typedef FAST FAST_LinStateSave AD_ContinuousStateType x_AD {:} - - "Continuous states" +typedef ^ ^ AD_DiscreteStateType xd_AD {:} - - "Discrete states" +typedef ^ ^ AD_ConstraintStateType z_AD {:} - - "Constraint states" +typedef ^ ^ AD_OtherStateType OtherSt_AD {:} - - "Other states" +typedef ^ ^ AD_InputType u_AD {:} - - "System inputs" +# ..... InflowWind OP data ....................................................................................................... +typedef FAST FAST_LinStateSave InflowWind_ContinuousStateType x_IfW {:} - - "Continuous states" +typedef ^ ^ InflowWind_DiscreteStateType xd_IfW {:} - - "Discrete states" +typedef ^ ^ InflowWind_ConstraintStateType z_IfW {:} - - "Constraint states" +typedef ^ ^ InflowWind_OtherStateType OtherSt_IfW {:} - - "Other states" +typedef ^ ^ InflowWind_InputType u_IfW {:} - - "System inputs" +# ..... No OpenFOAM integration data ....................................................................................................... +# ..... SubDyn OP data ....................................................................................................... +typedef FAST FAST_LinStateSave SD_ContinuousStateType x_SD {:} - - "Continuous states" +typedef ^ ^ SD_DiscreteStateType xd_SD {:} - - "Discrete states" +typedef ^ ^ SD_ConstraintStateType z_SD {:} - - "Constraint states" +typedef ^ ^ SD_OtherStateType OtherSt_SD {:} - - "Other states" +typedef ^ ^ SD_InputType u_SD {:} - - "System inputs" +# ..... ExtPtfm OP data ....................................................................................................... +typedef FAST FAST_LinStateSave ExtPtfm_ContinuousStateType x_ExtPtfm {:} - - "Continuous states" +typedef ^ ^ ExtPtfm_DiscreteStateType xd_ExtPtfm {:} - - "Discrete states" +typedef ^ ^ ExtPtfm_ConstraintStateType z_ExtPtfm {:} - - "Constraint states" +typedef ^ ^ ExtPtfm_OtherStateType OtherSt_ExtPtfm {:} - - "Other states" +typedef ^ ^ ExtPtfm_InputType u_ExtPtfm {:} - - "System inputs" +# ..... HydroDyn OP data ....................................................................................................... +typedef FAST FAST_LinStateSave HydroDyn_ContinuousStateType x_HD {:} - - "Continuous states" +typedef ^ ^ HydroDyn_DiscreteStateType xd_HD {:} - - "Discrete states" +typedef ^ ^ HydroDyn_ConstraintStateType z_HD {:} - - "Constraint states" +typedef ^ ^ HydroDyn_OtherStateType OtherSt_HD {:} - - "Other states" +typedef ^ ^ HydroDyn_InputType u_HD {:} - - "System inputs" +# ..... IceFloe OP data ....................................................................................................... +typedef FAST FAST_LinStateSave IceFloe_ContinuousStateType x_IceF {:} - - "Continuous states" +typedef ^ ^ IceFloe_DiscreteStateType xd_IceF {:} - - "Discrete states" +typedef ^ ^ IceFloe_ConstraintStateType z_IceF {:} - - "Constraint states" +typedef ^ ^ IceFloe_OtherStateType OtherSt_IceF {:} - - "Other states" +typedef ^ ^ IceFloe_InputType u_IceF {:} - - "System inputs" +# ..... MAP OP data ....................................................................................................... +typedef FAST FAST_LinStateSave MAP_ContinuousStateType x_MAP {:} - - "Continuous states" +typedef ^ ^ MAP_DiscreteStateType xd_MAP {:} - - "Discrete states" +typedef ^ ^ MAP_ConstraintStateType z_MAP {:} - - "Constraint states" +#typedef ^ ^ MAP_OtherStateType OtherSt_MAP {:} - - "Other states" +typedef ^ ^ MAP_InputType u_MAP {:} - - "System inputs" +# ..... FEAMooring OP data ....................................................................................................... +typedef FAST FAST_LinStateSave FEAM_ContinuousStateType x_FEAM {:} - - "Continuous states" +typedef ^ ^ FEAM_DiscreteStateType xd_FEAM {:} - - "Discrete states" +typedef ^ ^ FEAM_ConstraintStateType z_FEAM {:} - - "Constraint states" +typedef ^ ^ FEAM_OtherStateType OtherSt_FEAM {:} - - "Other states" +typedef ^ ^ FEAM_InputType u_FEAM {:} - - "System inputs" +# ..... MoorDyn OP data ....................................................................................................... +typedef FAST FAST_LinStateSave MD_ContinuousStateType x_MD {:} - - "Continuous states" +typedef ^ ^ MD_DiscreteStateType xd_MD {:} - - "Discrete states" +typedef ^ ^ MD_ConstraintStateType z_MD {:} - - "Constraint states" +typedef ^ ^ MD_OtherStateType OtherSt_MD {:} - - "Other states" +typedef ^ ^ MD_InputType u_MD {:} - - "System inputs" +# ..... NO OrcaFlex OP data ....................................................................................................... # ..... FAST_LinType data ....................................................................................................... typedef FAST FAST_LinType CHARACTER(LinChanLen) Names_u {:} - - "Names of the linearized inputs" @@ -156,6 +273,8 @@ typedef ^ FAST_LinType ReKi op_x {:} - - "continuous state operating point" typedef ^ FAST_LinType ReKi op_dx {:} - - "1st time derivative of continuous state operating point" typedef ^ FAST_LinType ReKi op_xd {:} - - "discrete state operating point" typedef ^ FAST_LinType ReKi op_z {:} - - "constraint state operating point" +typedef ^ FAST_LinType R8Ki op_x_eig_mag {:} - - "continuous state eigenvector magnitude" +typedef ^ FAST_LinType R8Ki op_x_eig_phase {:} - - "continuous state eigenvector phase" typedef ^ FAST_LinType Logical Use_u {:} - - "array same size as names_u, which indicates if this input is used in linearization output file" typedef ^ FAST_LinType Logical Use_y {:} - - "array same size as names_y, which indicates if this output is used in linearization output file" typedef ^ FAST_LinType R8Ki A {:}{:} - - "A matrix" @@ -175,14 +294,31 @@ typedef ^ FAST_LinType IntKi SizeLin {3} - - "sizes of (1) the module's inputs, typedef ^ FAST_LinType IntKi LinStartIndx {3} - - "the starting index in combined matrices of (1) the module's inputs, (2) the module's linearized outputs, and (3) the module's continuous states" - typedef ^ FAST_LinType IntKi NumOutputs - - - "number of WriteOutputs in each linearized module" - -# ..... FAST_ModLinType data ....................................................................................................... +# ..... FAST_ModLinType data (for output) ........................................................................................... typedef ^ FAST_ModLinType FAST_LinType Instance {:} - - "Linearization data for each module instance (e.g., 3 blades for BD)" # ..... FAST_LinFileType data ....................................................................................................... typedef FAST FAST_LinFileType FAST_ModLinType Modules {NumModules} - - "Linearization data for each module" typedef ^ FAST_LinFileType FAST_LinType Glue - - - "Linearization data for the glue code (coupled system)" typedef ^ FAST_LinFileType ReKi RotSpeed - - - "Rotor azimuth angular speed" rad/s -typedef ^ FAST_LinFileType ReKi Azimuth - - - +typedef ^ FAST_LinFileType ReKi Azimuth - - - "Rotor azimuth position" rad +typedef ^ FAST_LinFileType ReKi WindSpeed - - - "Wind speed at reference height" m/s + + +# ..... FAST_MiscLinType data ....................................................................................................... +typedef ^ FAST_MiscLinType DbKi LinTimes {:} - - "List of times at which to linearize" s +typedef ^ FAST_MiscLinType IntKi CopyOP_CtrlCode - - - "mesh control code for copy type (new on first call; update otherwise)" - +typedef ^ FAST_MiscLinType DbKi AzimTarget {:} - - "target azimuth positions in CalcSteady algorithm" rad +typedef ^ FAST_MiscLinType logical IsConverged - - - "whether the error calculation in the CalcSteady algorithm is converged" - +typedef ^ FAST_MiscLinType logical FoundSteady - - - "whether the CalcSteady algorithm found a steady-state solution" - +typedef ^ FAST_MiscLinType IntKi n_rot - - - "number of rotations completed in CalcSteady algorithm" - +typedef ^ FAST_MiscLinType IntKi AzimIndx - - - "index into target azimuth array in CalcSteady algorithm" - +typedef ^ FAST_MiscLinType IntKi NextLinTimeIndx - - - "index for next time in LinTimes where linearization should occur" - +typedef ^ FAST_MiscLinType DbKi Psi {:} - - "Azimuth angle at the current and previous time steps (uses LinInterpOrder); DbKi so that we can use registry-generated extrap/interp routines" - +typedef ^ FAST_MiscLinType ReKi y_interp {:} - - "Interpolated outputs packed into an array" - +typedef ^ FAST_MiscLinType ReKi y_ref {:} - - "Reference output range for CalcSteady error calculation" - +typedef ^ FAST_MiscLinType ReKi Y_prevRot {:}{:} - - "Linearization outputs from previous rotor revolution at each target azimuth " - + # ..... FAST_OutputFileType data ....................................................................................................... typedef FAST FAST_OutputFileType DbKi TimeData {:} - - "Array to contain the time output data for the binary file (first output time and a time [fixed] increment)" @@ -198,9 +334,13 @@ typedef ^ FAST_OutputFileType CHARACTER(ChanLen) ChannelNames {:} - - "Names of typedef ^ FAST_OutputFileType CHARACTER(ChanLen) ChannelUnits {:} - - "Units for the output channels" typedef ^ FAST_OutputFileType ProgDesc Module_Ver {NumModules} - - "version information from all modules" typedef ^ FAST_OutputFileType CHARACTER(ChanLen) Module_Abrev {NumModules} - - "abbreviation for module (used in file output naming conventions)" +typedef ^ FAST_OutputFileType LOGICAL WriteThisStep - - - "Whether this step will be written in the FAST output files" typedef ^ FAST_OutputFileType IntKi VTK_count - - - "Number of VTK files written (for naming output files)" typedef ^ FAST_OutputFileType IntKi VTK_LastWaveIndx - - - "last index into wave array" - typedef ^ FAST_OutputFileType FAST_LinFileType Lin - - - "linearization data for output" +typedef ^ FAST_OutputFileType IntKi ActualChanLen - - - "width of the column headers output in the text and/or binary file" - +typedef ^ FAST_OutputFileType CHARACTER(30) OutFmt_a - - - "Format used for text tabular output (except time); combines OutFmt with delim and appropriate spaces" - +typedef ^ FAST_OutputFileType FAST_LinStateSave op - - - "operating points of states and inputs for VTK output of mode shapes" # ..... IceDyn data ....................................................................................................... @@ -228,6 +368,8 @@ typedef ^ ^ BD_ParameterType p {:} - - "Parameters" typedef ^ ^ BD_InputType u {:} - - "System inputs" typedef ^ ^ BD_OutputType y {:} - - "System outputs" typedef ^ ^ BD_MiscVarType m {:} - - "Misc/optimization variables" +typedef ^ ^ BD_OutputType Output {:}{:} - - "Array of outputs associated with CalcSteady Azimuths" +typedef ^ ^ BD_OutputType y_interp {:} - - "interpolated system outputs for CalcSteady" typedef ^ ^ BD_InputType Input {:}{:} - - "Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:}{:} - - "Array of times associated with Input Array" @@ -240,7 +382,8 @@ typedef ^ ^ ED_ParameterType p - - - "Parameters" typedef ^ ^ ED_InputType u - - - "System inputs" typedef ^ ^ ED_OutputType y - - - "System outputs" typedef ^ ^ ED_MiscVarType m - - - "Misc (optimization) variables not associated with time" -typedef ^ ^ ED_OutputType Output {:} - - "Array of outputs associated with InputTimes" +typedef ^ ^ ED_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" +typedef ^ ^ ED_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ ED_InputType Input {:} - - "Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" @@ -254,6 +397,8 @@ typedef ^ ^ SrvD_ParameterType p - - - "Parameters" typedef ^ ^ SrvD_InputType u - - - "System inputs" typedef ^ ^ SrvD_OutputType y - - - "System outputs" typedef ^ ^ SrvD_MiscVarType m - - - "Misc (optimization) variables not associated with time" +typedef ^ ^ SrvD_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" +typedef ^ ^ SrvD_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ SrvD_InputType Input {:} - - "Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" @@ -278,6 +423,8 @@ typedef ^ ^ AD_ParameterType p - - - "Parameters" typedef ^ ^ AD_InputType u - - - "System inputs" typedef ^ ^ AD_OutputType y - - - "System outputs" typedef ^ ^ AD_MiscVarType m - - - "Misc/optimization variables" +typedef ^ ^ AD_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" +typedef ^ ^ AD_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ AD_InputType Input {:} - - "Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" @@ -290,6 +437,8 @@ typedef ^ ^ InflowWind_ParameterType p - - - "Parameters" typedef ^ ^ InflowWind_InputType u - - - "System inputs" typedef ^ ^ InflowWind_OutputType y - - - "System outputs" typedef ^ ^ InflowWind_MiscVarType m - - - "Misc/optimization variables" +typedef ^ ^ InflowWind_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" +typedef ^ ^ InflowWind_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ InflowWind_InputType Input {:} - - "Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" @@ -337,6 +486,8 @@ typedef ^ ^ HydroDyn_ParameterType p - - - "Parameters" typedef ^ ^ HydroDyn_InputType u - - - "System inputs" typedef ^ ^ HydroDyn_OutputType y - - - "System outputs" typedef ^ ^ HydroDyn_MiscVarType m - - - "Misc/optimization variables" +typedef ^ ^ HydroDyn_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" +typedef ^ ^ HydroDyn_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ HydroDyn_InputType Input {:} - - "Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" @@ -361,6 +512,8 @@ typedef ^ ^ MAP_ParameterType p - - - "Parameters" typedef ^ ^ MAP_InputType u - - - "System inputs" typedef ^ ^ MAP_OutputType y - - - "System outputs" typedef ^ ^ MAP_OtherStateType OtherSt_old - - - "Other/optimization states (copied for the case of subcycling)" +typedef ^ ^ MAP_OutputType Output {:} - - "Array of outputs associated with CalcSteady Azimuths" +typedef ^ ^ MAP_OutputType y_interp - - - "interpolated system outputs for CalcSteady" typedef ^ ^ MAP_InputType Input {:} - - "Array of inputs associated with InputTimes" typedef ^ ^ DbKi InputTimes {:} - - "Array of times associated with Input Array" @@ -445,7 +598,7 @@ typedef ^ FAST_ModuleMapType MeshMapType SD_P_2_IceF_P - - - "Map SubDyn y2Mesh typedef ^ FAST_ModuleMapType MeshMapType IceD_P_2_SD_P {:} - - "Map IceDyn point mesh to SubDyn y2Mesh point mesh" typedef ^ FAST_ModuleMapType MeshMapType SD_P_2_IceD_P {:} - - "Map SubDyn y2Mesh point mesh to IceDyn point mesh" # Stored Jacobians: -typedef ^ FAST_ModuleMapType ReKi Jacobian_Opt1 {:}{:} - - "Stored Jacobian in ED_HD_InputOutputSolve or ED_SD_HD_BD_InputOutputSolve" +typedef ^ FAST_ModuleMapType ReKi Jacobian_Opt1 {:}{:} - - "Stored Jacobian in ED_HD_InputOutputSolve or FullOpt1_InputOutputSolve" typedef ^ FAST_ModuleMapType Integer Jacobian_pivot {:} - - "Pivot array used for LU decomposition of Jacobian_Opt1" typedef ^ FAST_ModuleMapType Integer Jac_u_indx {:}{:} - - "matrix to help fill/pack the u vector in computing the jacobian" # Temporary copies of input meshes (stored here so we don't have to keep allocating/destroying them) @@ -466,12 +619,50 @@ typedef ^ FAST_ModuleMapType MeshType u_ExtPtfm_PtfmMesh - - - "copy of ExtPtfm_ # ..... FAST_ExternalInput data ....................................................................................................... typedef FAST FAST_ExternInputType ReKi GenTrq - - - "generator torque input from Simulink/Labview" typedef ^ FAST_ExternInputType ReKi ElecPwr - - - "electric power input from Simulink/Labview" -typedef ^ FAST_ExternInputType ReKi YawPosCom - - - "yaw position command from Simulink/Labview" +typedef ^ FAST_ExternInputType ReKi YawPosCom - - 2pi "yaw position command from Simulink/Labview" typedef ^ FAST_ExternInputType ReKi YawRateCom - - - "yaw rate command from Simulink/Labview" -typedef ^ FAST_ExternInputType ReKi BlPitchCom 3 - - "blade pitch commands from Simulink/Labview" "rad/s" +typedef ^ FAST_ExternInputType ReKi BlPitchCom 3 - 2pi "blade pitch commands from Simulink/Labview" "rad" typedef ^ FAST_ExternInputType ReKi HSSBrFrac - - - "Fraction of full braking torque: 0 (off) <= HSSBrFrac <= 1 (full) from Simulink or LabVIEW" typedef ^ FAST_ExternInputType ReKi LidarFocus 3 - - "lidar focus (relative to lidar location)" m + +# ..... FAST_InitData data ....................................................................................................... +typedef ^ FAST_InitData ED_InitInputType InData_ED - - - "ED Initialization input data" +typedef ^ FAST_InitData ED_InitOutputType OutData_ED - - - "ED Initialization output data" +typedef ^ FAST_InitData BD_InitInputType InData_BD - - - "BD Initialization input data" +typedef ^ FAST_InitData BD_InitOutputType OutData_BD : - - "BD Initialization output data" +typedef ^ FAST_InitData SrvD_InitInputType InData_SrvD - - - "SrvD Initialization input data" +typedef ^ FAST_InitData SrvD_InitOutputType OutData_SrvD - - - "SrvD Initialization output data" +typedef ^ FAST_InitData AD14_InitInputType InData_AD14 - - - "AD14 Initialization input data" +typedef ^ FAST_InitData AD14_InitOutputType OutData_AD14 - - - "AD14 Initialization output data" +typedef ^ FAST_InitData AD_InitInputType InData_AD - - - "AD Initialization input data" +typedef ^ FAST_InitData AD_InitOutputType OutData_AD - - - "AD Initialization output data" +typedef ^ FAST_InitData InflowWind_InitInputType InData_IfW - - - "IfW Initialization input data" +typedef ^ FAST_InitData InflowWind_InitOutputType OutData_IfW - - - "IfW Initialization output data" +typedef ^ FAST_InitData OpFM_InitInputType InData_OpFM - - - "OpFM Initialization input data" +typedef ^ FAST_InitData OpFM_InitOutputType OutData_OpFM - - - "OpFM Initialization output data" +typedef ^ FAST_InitData HydroDyn_InitInputType InData_HD - - - "HD Initialization input data" +typedef ^ FAST_InitData HydroDyn_InitOutputType OutData_HD - - - "HD Initialization output data" +typedef ^ FAST_InitData SD_InitInputType InData_SD - - - "SD Initialization input data" +typedef ^ FAST_InitData SD_InitOutputType OutData_SD - - - "SD Initialization output data" +typedef ^ FAST_InitData ExtPtfm_InitInputType InData_ExtPtfm - - - "ExtPtfm Initialization input data" +typedef ^ FAST_InitData ExtPtfm_InitOutputType OutData_ExtPtfm - - - "ExtPtfm Initialization output data" +typedef ^ FAST_InitData MAP_InitInputType InData_MAP - - - "MAP Initialization input data" +typedef ^ FAST_InitData MAP_InitOutputType OutData_MAP - - - "MAP Initialization output data" +typedef ^ FAST_InitData FEAM_InitInputType InData_FEAM - - - "FEAM Initialization input data" +typedef ^ FAST_InitData FEAM_InitOutputType OutData_FEAM - - - "FEAM Initialization output data" +typedef ^ FAST_InitData MD_InitInputType InData_MD - - - "MD Initialization input data" +typedef ^ FAST_InitData MD_InitOutputType OutData_MD - - - "MD Initialization output data" +typedef ^ FAST_InitData Orca_InitInputType InData_Orca - - - "Orca Initialization input data" +typedef ^ FAST_InitData Orca_InitOutputType OutData_Orca - - - "Orca Initialization output data" +typedef ^ FAST_InitData IceFloe_InitInputType InData_IceF - - - "IceF Initialization input data" +typedef ^ FAST_InitData IceFloe_InitOutputType OutData_IceF - - - "IceF Initialization output data" +typedef ^ FAST_InitData IceD_InitInputType InData_IceD - - - "IceD Initialization input data" +typedef ^ FAST_InitData IceD_InitOutputType OutData_IceD - - - "IceD Initialization output data (each instance will have the same output channels)" +typedef ^ FAST_InitData SC_InitInputType InData_SC - - - "SC Initialization input data" +typedef ^ FAST_InitData SC_InitOutputType OutData_SC - - - "SC Initialization output data" + + # ..... FAST_MiscVarType data ....................................................................................................... typedef FAST FAST_MiscVarType DbKi TiLstPrn - - - "The simulation time of the last print (to file)" (s) typedef ^ FAST_MiscVarType DbKi t_global - - - "Current simulation time (for global/FAST simulation)" (s) @@ -484,7 +675,7 @@ typedef ^ FAST_MiscVarType INTEGER SimStrtTime {8} - - "Start time of simulation #typedef ^ FAST_MiscVarType IntKi n_t_global - - - "simulation time step, loop counter for global (FAST) simulation" (s) typedef ^ FAST_MiscVarType Logical calcJacobian - - - "Should we calculate Jacobians in Option 1?" (flag) typedef ^ FAST_MiscVarType FAST_ExternInputType ExternInput - - - "external input values" - -typedef ^ FAST_MiscVarType INTEGER NextLinTimeIndx - - - "index for next time in LinTimes where linearization should occur" - +typedef ^ FAST_MiscVarType FAST_MiscLinType Lin - - - "misc data for linearization analysis" - # ..... FAST External Initialization Input data ....................................................................................................... typedef ^ FAST_ExternInitType DbKi Tmax - -1 - "External code specified Tmax" s @@ -526,3 +717,4 @@ typedef ^ FAST_TurbineType OrcaFlex_Data Orca - - - "Data for the OrcaFlex inter typedef ^ FAST_TurbineType IceFloe_Data IceF - - - "Data for the IceFloe module" - typedef ^ FAST_TurbineType IceDyn_Data IceD - - - "Data for the IceDyn module" - typedef ^ FAST_TurbineType ExtPtfm_Data ExtPtfm - - - "Data for the ExtPtfm (external platform loading) module" - +#typedef ^ FAST_TurbineType FAST_InitData Init - - - "Data for all modules at initialization" - diff --git a/modules/openfast-library/src/FAST_Solver.f90 b/modules/openfast-library/src/FAST_Solver.f90 index 09a6356209..81c35893b6 100644 --- a/modules/openfast-library/src/FAST_Solver.f90 +++ b/modules/openfast-library/src/FAST_Solver.f90 @@ -52,19 +52,26 @@ MODULE FAST_Solver !---------------------------------------------------------------------------------------------------------------------------------- !> This routine sets the inputs required for BD--using the Option 2 solve method; currently the only inputs solved in this routine !! are the blade distributed loads from AD15; other inputs are solved in option 1. -SUBROUTINE BD_InputSolve( p_FAST, BD, y_AD, u_AD, MeshMapData, ErrStat, ErrMsg ) +SUBROUTINE BD_InputSolve( p_FAST, BD, y_AD, u_AD, y_ED, MeshMapData, ErrStat, ErrMsg ) !.................................................................................................................................. TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Glue-code simulation parameters TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BD Inputs at t TYPE(AD_OutputType), INTENT(IN ) :: y_AD !< AeroDyn outputs TYPE(AD_InputType), INTENT(IN ) :: u_AD !< AD inputs (for AD-BD load transfer) + TYPE(ED_OutputType), INTENT(IN ) :: y_ED !< ElastoDyn outputs TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message ! local variables + REAL(R8Ki) :: omega_c(3) ! variable for adding damping + REAL(R8Ki) :: r(3) ! variable for adding damping + REAL(R8Ki) :: r_hub(3) ! variable for adding damping + REAL(R8Ki) :: Vrot(3) ! variable for adding damping + + INTEGER(IntKi) :: J ! Loops through blade nodes INTEGER(IntKi) :: K ! Loops through blades INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None @@ -115,7 +122,37 @@ SUBROUTINE BD_InputSolve( p_FAST, BD, y_AD, u_AD, MeshMapData, ErrStat, ErrMsg ) END IF - + ! add damping in blades for linearization convergence + if (p_FAST%CalcSteady) then + + ! note that this assumes sibling meshes for input and output + + omega_c = y_ED%RotSpeed * y_ED%HubPtMotion%Orientation(1,:,1) + r_hub = y_ED%HubPtMotion%Position(:,1) + y_ED%HubPtMotion%TranslationDisp(:,1) + + if (p_FAST%BD_OutputSibling) then + + do k = 1,p_FAST%nBeams ! Loop through all blades + do j = 1,BD%Input(1,k)%DistrLoad%NNodes + r = BD%y(k)%BldMotion%Position(:,j) + BD%y(k)%BldMotion%TranslationDisp(:,j) - r_hub + Vrot = cross_product(omega_c, r) + BD%Input(1,k)%DistrLoad%Force(:,j) = BD%Input(1,k)%DistrLoad%Force(:,j) - p_FAST%Bld_Kdmp * ( BD%y(k)%BldMotion%TranslationVel(:,j) - Vrot ) + end do + end do + + else + + do k = 1,p_FAST%nBeams ! Loop through all blades + do j = 1,BD%Input(1,k)%DistrLoad%NNodes + r = MeshMapData%y_BD_BldMotion_4Loads(k)%Position(:,j) + MeshMapData%y_BD_BldMotion_4Loads(k)%TranslationDisp(:,j) - r_hub + Vrot = cross_product(omega_c, r) + BD%Input(1,k)%DistrLoad%Force(:,j) = BD%Input(1,k)%DistrLoad%Force(:,j) - p_FAST%Bld_Kdmp * ( MeshMapData%y_BD_BldMotion_4Loads(k)%TranslationVel(:,j) - Vrot ) + end do + end do + + end if + + end if END SUBROUTINE BD_InputSolve !---------------------------------------------------------------------------------------------------------------------------------- @@ -139,6 +176,11 @@ SUBROUTINE ED_InputSolve( p_FAST, u_ED, y_ED, p_AD14, y_AD14, y_AD, y_SrvD, u_AD CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message ! local variables + REAL(R8Ki) :: omega_c(3) ! variable for adding damping + REAL(R8Ki) :: r(3) ! variable for adding damping + REAL(R8Ki) :: r_hub(3) ! variable for adding damping + REAL(R8Ki) :: Vrot(3) ! variable for adding damping + INTEGER(IntKi) :: J ! Loops through nodes / elements INTEGER(IntKi) :: K ! Loops through blades INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation @@ -261,6 +303,30 @@ SUBROUTINE ED_InputSolve( p_FAST, u_ED, y_ED, p_AD14, y_AD14, y_AD, y_SrvD, u_AD u_ED%TwrAddedMass = 0.0_ReKi u_ED%PtfmAddedMass = 0.0_ReKi + + ! add damping in blades and tower for linearization convergence + if (p_FAST%CalcSteady) then + + ! note that this assumes sibling meshes for input and output (the ED bladeLn2Mesh has the same first same first BladePtLoads%NNodes nodes as BladePtLoads, so this is okay) + do j = 1,u_ED%TowerPtLoads%NNodes ! u_ED%TowerPtLoads%NNodes is two less than y_ED%TowerLn2Mesh%NNodes + u_ED%TowerPtLoads%Force(:,j) = u_ED%TowerPtLoads%Force(:,j) - p_FAST%Twr_Kdmp * y_ED%TowerLn2Mesh%TranslationVel(:,j) + end do + + IF (p_FAST%CompElast == Module_ED) THEN + omega_c = y_ED%RotSpeed * y_ED%HubPtMotion%Orientation(1,:,1) + r_hub = y_ED%HubPtMotion%Position(:,1) + y_ED%HubPtMotion%TranslationDisp(:,1) + + do k=1,SIZE(u_ED%BladePtLoads,1) + do j = 1,u_ED%BladePtLoads(k)%NNodes + r = y_ED%BladeLn2Mesh(k)%Position(:,j) + y_ED%BladeLn2Mesh(k)%TranslationDisp(:,j) - r_hub + Vrot = cross_product(omega_c, r) + u_ED%BladePtLoads(k)%Force(:,j) = u_ED%BladePtLoads(k)%Force(:,j) - p_FAST%Bld_Kdmp * ( y_ED%BladeLn2Mesh(k)%TranslationVel(:,j) - Vrot ) + end do + end do + END IF + + end if + END SUBROUTINE ED_InputSolve !---------------------------------------------------------------------------------------------------------------------------------- !> This routine determines the points in space where InflowWind needs to compute wind speeds. @@ -270,7 +336,7 @@ SUBROUTINE IfW_InputSolve( p_FAST, m_FAST, u_IfW, p_IfW, u_AD14, u_AD, y_ED, Err TYPE(InflowWind_ParameterType), INTENT(IN ) :: p_IfW !< The parameters to InflowWind TYPE(AD14_InputType), INTENT(IN) :: u_AD14 !< The input meshes (already calculated) from AeroDyn14 TYPE(AD_InputType), INTENT(IN) :: u_AD !< The input meshes (already calculated) from AeroDyn - TYPE(ED_OutputType), INTENT(IN) :: y_ED !< The outputs of the structural dynamics module + TYPE(ED_OutputType), INTENT(IN) :: y_ED !< The outputs of the structural dynamics module (for IfW Lidar) TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< FAST parameter data TYPE(FAST_MiscVarType), INTENT(IN ) :: m_FAST !< misc FAST data, including inputs from external codes like Simulink @@ -344,7 +410,6 @@ SUBROUTINE IfW_SetExternalInputs( p_IfW, m_FAST, y_ED, u_IfW ) TYPE(ED_OutputType), INTENT(IN) :: y_ED !< The outputs of the structural dynamics module TYPE(InflowWind_InputType), INTENT(INOUT) :: u_IfW !< InflowWind Inputs at t - ! local variables ! bjj: this is a total hack to get the lidar inputs into InflowWind. We should use a mesh to take care of this messiness (and, really this Lidar Focus should come ! from Fortran (a scanning pattern or file-lookup inside InflowWind), not MATLAB. @@ -516,8 +581,8 @@ SUBROUTINE AD_InputSolve_NoIfW( p_FAST, u_AD, y_SrvD, y_ED, BD, MeshMapData, Err END IF - - + + ! Set Conrol parameter (i.e. flaps) if using ServoDyn ! bem: This takes in flap deflection for each blade (only one flap deflection angle per blade), ! from ServoDyn (which comes from Bladed style DLL controller) @@ -721,7 +786,7 @@ SUBROUTINE AD14_InputSolve_NoIfW( p_FAST, u_AD14, y_ED, MeshMapData, ErrStat, Er END SUBROUTINE AD14_InputSolve_NoIfW !---------------------------------------------------------------------------------------------------------------------------------- !> This routine sets the inputs required for ServoDyn -SUBROUTINE SrvD_InputSolve( p_FAST, m_FAST, u_SrvD, y_ED, y_IfW, y_OpFM, y_BD, MeshMapData, ErrStat, ErrMsg, y_SrvD_prev ) +SUBROUTINE SrvD_InputSolve( p_FAST, m_FAST, u_SrvD, y_ED, y_IfW, y_OpFM, y_BD, MeshMapData, ErrStat, ErrMsg ) !.................................................................................................................................. TYPE(FAST_ParameterType), INTENT(IN) :: p_FAST !< Glue-code simulation parameters @@ -731,7 +796,6 @@ SUBROUTINE SrvD_InputSolve( p_FAST, m_FAST, u_SrvD, y_ED, y_IfW, y_OpFM, y_BD, M TYPE(InflowWind_OutputType), INTENT(IN) :: y_IfW !< InflowWind outputs TYPE(OpFM_OutputType), INTENT(IN) :: y_OpFM !< OpenFOAM outputs TYPE(BD_OutputType), INTENT(IN) :: y_BD(:) !< BD Outputs - TYPE(SrvD_OutputType), OPTIONAL, INTENT(IN) :: y_SrvD_prev !< ServoDyn outputs from t - dt TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message @@ -747,14 +811,9 @@ SUBROUTINE SrvD_InputSolve( p_FAST, m_FAST, u_SrvD, y_ED, y_IfW, y_OpFM, y_BD, M ErrStat = ErrID_None ErrMsg = "" - ! ServoDyn inputs from combination of InflowWind and ElastoDyn - - u_SrvD%YawAngle = y_ED%YawAngle !nacelle yaw plus platform yaw - - ! Calculate horizontal hub-height wind direction and the nacelle yaw error estimate (both positive about zi-axis); these are + ! Calculate horizontal hub-height wind direction (positive about zi-axis); these are ! zero if there is no wind input when InflowWind is not used: - - !bjj: rename pass YawAngle (not YawErr from ED) + IF ( p_FAST%CompInflow == Module_IfW ) THEN u_SrvD%WindDir = ATAN2( y_IfW%VelocityUVW(2,1), y_IfW%VelocityUVW(1,1) ) @@ -770,23 +829,22 @@ SUBROUTINE SrvD_InputSolve( p_FAST, m_FAST, u_SrvD, y_ED, y_IfW, y_OpFM, y_BD, M if ( allocated(u_SrvD%SuperController) ) then u_SrvD%SuperController = y_OpFM%SuperController end if - - + ELSE ! No wind inflow u_SrvD%WindDir = 0.0 - u_SrvD%YawErr = 0.0 u_SrvD%HorWindV = 0.0 ENDIF - ! ServoDyn inputs from ServoDyn outputs at previous step - ! Jason says this violates the framework, but it's only for the Bladed DLL, which itself violates the framework, so I don't care. - IF (PRESENT(y_SrvD_prev)) THEN - u_SrvD%ElecPwr_prev = y_SrvD_prev%ElecPwr ! we want to know the electrical power from the previous time step (for the Bladed DLL) - u_SrvD%GenTrq_prev = y_SrvD_prev%GenTrq ! we want to know the electrical generator torque from the previous time step (for the Bladed DLL) - ! Otherwise, we'll use the guess provided by the module (this only happens at Step=0) - END IF + + + + ! ServoDyn inputs from combination of InflowWind and ElastoDyn + + u_SrvD%YawAngle = y_ED%YawAngle !nacelle yaw plus platform yaw + u_SrvD%YawErr = u_SrvD%WindDir - u_SrvD%YawAngle ! the nacelle yaw error estimate (positive about zi-axis) + ! ServoDyn inputs from ElastoDyn u_SrvD%Yaw = y_ED%Yaw !nacelle yaw @@ -805,8 +863,8 @@ SUBROUTINE SrvD_InputSolve( p_FAST, m_FAST, u_SrvD, y_ED, y_IfW, y_OpFM, y_BD, M end do ELSE - u_SrvD%RootMxc = y_ED%RootMxc - u_SrvD%RootMyc = y_ED%RootMyc + u_SrvD%RootMxc = y_ED%RootMxc ! fixed-size arrays: always size 3 + u_SrvD%RootMyc = y_ED%RootMyc ! fixed-size arrays: always size 3 END IF @@ -920,10 +978,10 @@ SUBROUTINE Transfer_SD_to_HD( y_SD, u_HD_M_LumpedMesh, u_HD_M_DistribMesh, MeshM END SUBROUTINE Transfer_SD_to_HD !---------------------------------------------------------------------------------------------------------------------------------- -!> This routine transfers the ED outputs into inputs required for HD -SUBROUTINE Transfer_ED_to_HD( y_ED, u_HD, MeshMapData, ErrStat, ErrMsg ) +!> This routine transfers the platform motion output of the structural module (ED) into inputs required for HD +SUBROUTINE Transfer_PlatformMotion_to_HD( PlatformMotion, u_HD, MeshMapData, ErrStat, ErrMsg ) !.................................................................................................................................. - TYPE(ED_OutputType), INTENT(IN ) :: y_ED !< The outputs of the structural dynamics module + TYPE(MeshType), INTENT(IN ) :: PlatformMotion !< The platform motion outputs of the structural dynamics module TYPE(HydroDyn_InputType), INTENT(INOUT) :: u_HD !< HydroDyn input TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< data for mapping meshes between modules @@ -933,6 +991,7 @@ SUBROUTINE Transfer_ED_to_HD( y_ED, u_HD, MeshMapData, ErrStat, ErrMsg ) ! local variables INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None + CHARACTER(*), PARAMETER :: RoutineName = 'Transfer_PlatformMotion_to_HD' ErrStat = ErrID_None @@ -946,8 +1005,8 @@ SUBROUTINE Transfer_ED_to_HD( y_ED, u_HD, MeshMapData, ErrStat, ErrMsg ) ! wave kinematics, additional preload, additional stiffness, additional linear damping, additional quadratic damping, ! hydrodynamic added mass - CALL Transfer_Point_to_Point( y_ED%PlatformPtMesh, u_HD%Mesh, MeshMapData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg,'Transfer_ED_to_HD (u_HD%Mesh)' ) + CALL Transfer_Point_to_Point( PlatformMotion, u_HD%Mesh, MeshMapData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg, RoutineName//' (u_HD%Mesh)' ) END IF !WAMIT @@ -955,20 +1014,20 @@ SUBROUTINE Transfer_ED_to_HD( y_ED, u_HD, MeshMapData, ErrStat, ErrMsg ) IF ( u_HD%Morison%LumpedMesh%Committed ) THEN ! These are the motions for the lumped point loads associated viscous drag on the WAMIT body and/or filled/flooded lumped forces of the WAMIT body - CALL Transfer_Point_to_Point( y_ED%PlatformPtMesh, u_HD%Morison%LumpedMesh, MeshMapData%ED_P_2_HD_M_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg,'Transfer_ED_to_HD (u_HD%Morison%LumpedMesh)' ) + CALL Transfer_Point_to_Point( PlatformMotion, u_HD%Morison%LumpedMesh, MeshMapData%ED_P_2_HD_M_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg, RoutineName//' (u_HD%Morison%LumpedMesh)' ) END IF IF ( u_HD%Morison%DistribMesh%Committed ) THEN ! These are the motions for the line2 (distributed) loads associated viscous drag on the WAMIT body and/or filled/flooded distributed forces of the WAMIT body - CALL Transfer_Point_to_Line2( y_ED%PlatformPtMesh, u_HD%Morison%DistribMesh, MeshMapData%ED_P_2_HD_M_L, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg,'Transfer_ED_to_HD (u_HD%Morison%DistribMesh)' ) + CALL Transfer_Point_to_Line2( PlatformMotion, u_HD%Morison%DistribMesh, MeshMapData%ED_P_2_HD_M_L, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg, RoutineName//' (u_HD%Morison%DistribMesh)' ) END IF -END SUBROUTINE Transfer_ED_to_HD +END SUBROUTINE Transfer_PlatformMotion_to_HD !---------------------------------------------------------------------------------------------------------------------------------- !> This routine transfers the ED outputs into inputs required for HD, SD, ExtPtfm, BD, MAP, and/or FEAM SUBROUTINE Transfer_ED_to_HD_SD_BD_Mooring( p_FAST, y_ED, u_HD, u_SD, u_ExtPtfm, u_MAP, u_FEAM, u_MD, u_Orca, u_BD, MeshMapData, ErrStat, ErrMsg ) @@ -1004,19 +1063,25 @@ SUBROUTINE Transfer_ED_to_HD_SD_BD_Mooring( p_FAST, y_ED, u_HD, u_SD, u_ExtPtfm, CALL Transfer_Point_to_Point( y_ED%PlatformPtMesh, u_SD%TPMesh, MeshMapData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg,RoutineName//':u_SD%TPMesh' ) + IF ( p_FAST%CompHydro == Module_HD ) call TransferFixedBottomToHD() + ELSEIF ( p_FAST%CompSub == Module_ExtPtfm ) THEN ! Map ED (motion) outputs to ExtPtfm inputs: CALL Transfer_Point_to_Point( y_ED%PlatformPtMesh, u_ExtPtfm%PtfmMesh, MeshMapData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg,RoutineName//':u_ExtPtfm%PtfmMesh' ) + IF ( p_FAST%CompHydro == Module_HD ) call TransferFixedBottomToHD() ELSEIF ( p_FAST%CompHydro == Module_HD ) THEN ! Map ED outputs to HD inputs: - CALL Transfer_ED_to_HD( y_ED, u_HD, MeshMapData, ErrStat2, ErrMsg2 ) + CALL Transfer_PlatformMotion_to_HD( y_ED%PlatformPtMesh, u_HD, MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg,RoutineName ) - END IF + END IF + + + IF ( p_FAST%CompElast == Module_BD .and. BD_Solve_Option1) THEN ! map ED root and hub motion outputs to BeamDyn: @@ -1048,7 +1113,19 @@ SUBROUTINE Transfer_ED_to_HD_SD_BD_Mooring( p_FAST, y_ED, u_HD, u_SD, u_ExtPtfm, CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg,RoutineName//'u_Orca%PtfmMesh' ) END IF - +contains + subroutine TransferFixedBottomToHD() + IF ( u_HD%Mesh%Committed ) THEN + + ! These are the motions for the lumped point loads associated the WAMIT body and include: hydrostatics, radiation memory effect, + ! wave kinematics, additional preload, additional stiffness, additional linear damping, additional quadratic damping, + ! hydrodynamic added mass + + CALL Transfer_Point_to_Point( y_ED%PlatformPtMesh, u_HD%Mesh, MeshMapData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg, RoutineName//' (u_HD%Mesh)' ) + + END IF !WAMIT + end subroutine END SUBROUTINE Transfer_ED_to_HD_SD_BD_Mooring !---------------------------------------------------------------------------------------------------------------------------------- !> This routine sets the inputs required for MAP. @@ -1242,11 +1319,11 @@ END SUBROUTINE Transfer_ED_to_BD_tmp SUBROUTINE Transfer_HD_to_SD( u_mapped, u_SD_LMesh, u_mapped_positions, y_HD, u_HD_M_LumpedMesh, u_HD_M_DistribMesh, MeshMapData, ErrStat, ErrMsg ) !.................................................................................................................................. TYPE(MeshType), INTENT(INOUT) :: u_mapped !< temporary copy of SD mesh (an argument to avoid another temporary mesh copy) - TYPE(MeshType), INTENT(INOUT) :: u_SD_LMesh !< SD Inputs on LMesh at t (separate so we can call from ED_SD_HD_InputOutput solve with temp meshes) + TYPE(MeshType), INTENT(INOUT) :: u_SD_LMesh !< SD Inputs on LMesh at t (separate so we can call from FullOpt1_InputOutputSolve with temp meshes) TYPE(MeshType), INTENT(IN ) :: u_mapped_positions !< Mesh sibling of u_mapped, with displaced positions TYPE(HydroDyn_OutputType), INTENT(IN ) :: y_HD !< HydroDyn outputs - TYPE(MeshType), INTENT(IN ) :: u_HD_M_LumpedMesh !< HydroDyn input mesh (separate so we can call from ED_SD_HD_InputOutput solve with temp meshes) - TYPE(MeshType), INTENT(IN ) :: u_HD_M_DistribMesh !< HydroDyn input mesh (separate so we can call from ED_SD_HD_InputOutput solve with temp meshes) + TYPE(MeshType), INTENT(IN ) :: u_HD_M_LumpedMesh !< HydroDyn input mesh (separate so we can call from FullOpt1_InputOutputSolve with temp meshes) + TYPE(MeshType), INTENT(IN ) :: u_HD_M_DistribMesh !< HydroDyn input mesh (separate so we can call from FullOpt1_InputOutputSolve with temp meshes) TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status @@ -1326,7 +1403,7 @@ SUBROUTINE ED_HD_InputOutputSolve( this_time, p_FAST, calcJacobian & , u_ED, p_ED, x_ED, xd_ED, z_ED, OtherSt_ED, y_ED, m_ED & , u_HD, p_HD, x_HD, xd_HD, z_HD, OtherSt_HD, y_HD, m_HD & , u_MAP, y_MAP, u_FEAM, y_FEAM, u_MD, y_MD & - , MeshMapData , ErrStat, ErrMsg ) + , MeshMapData , ErrStat, ErrMsg, WriteThisStep ) !.................................................................................................................................. USE ElastoDyn @@ -1369,6 +1446,7 @@ SUBROUTINE ED_HD_InputOutputSolve( this_time, p_FAST, calcJacobian & TYPE(FAST_ModuleMapType) , INTENT(INOUT) :: MeshMapData !< data for mapping meshes between modules INTEGER(IntKi) , INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*) , INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + LOGICAL , INTENT(IN ) :: WriteThisStep !< Will we print the WriteOutput values this step? ! Local variables: INTEGER, PARAMETER :: NumInputs = SizeJac_ED_HD !12 @@ -1425,12 +1503,12 @@ SUBROUTINE ED_HD_InputOutputSolve( this_time, p_FAST, calcJacobian & ! Local copies for perturbing inputs and outputs (computing Jacobian): IF ( calcJacobian ) THEN CALL ED_CopyInput( u_ED, u_ED_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyOutput( y_ED, y_ED_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL ED_CopyOutput( y_ED, y_ED_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyInput( u_HD, u_HD_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) + CALL HydroDyn_CopyInput( u_HD, u_HD_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL HydroDyn_CopyOutput( y_HD, y_HD_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) + CALL HydroDyn_CopyOutput( y_HD, y_HD_perturb, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF @@ -1445,14 +1523,14 @@ SUBROUTINE ED_HD_InputOutputSolve( this_time, p_FAST, calcJacobian & ! make hydrodyn inputs consistant with elastodyn outputs ! (do this because we're using outputs in the u vector): - CALL Transfer_ED_to_HD(y_ED_input, u_HD, MeshMapData, ErrStat2, ErrMsg2 ) ! get u_HD from y_ED_input - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL Transfer_PlatformMotion_to_HD(y_ED_input%PlatformPtMesh, u_HD, MeshMapData, ErrStat2, ErrMsg2 ) ! get u_HD from y_ED_input + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - u( 1: 3) = u_ED%PlatformPtMesh%Force(:,1) / p_FAST%UJacSclFact - u( 4: 6) = u_ED%PlatformPtMesh%Moment(:,1) / p_FAST%UJacSclFact - u( 7: 9) = y_ED_input%PlatformPtMesh%TranslationAcc(:,1) - u(10:12) = y_ED_input%PlatformPtMesh%RotationAcc(:,1) + u( 1: 3) = u_ED%PlatformPtMesh%Force(:,1) / p_FAST%UJacSclFact + u( 4: 6) = u_ED%PlatformPtMesh%Moment(:,1) / p_FAST%UJacSclFact + u( 7: 9) = y_ED_input%PlatformPtMesh%TranslationAcc(:,1) + u(10:12) = y_ED_input%PlatformPtMesh%RotationAcc(:,1) K = 0 @@ -1519,7 +1597,7 @@ SUBROUTINE ED_HD_InputOutputSolve( this_time, p_FAST, calcJacobian & !............................... ! Get HydroDyn's contribution: - !............................... + !............................... DO i=7,12 !call HD_CalcOutput ! we want to perturb u_HD, but we're going to perturb the input y_ED and transfer that to HD to get u_HD @@ -1527,7 +1605,7 @@ SUBROUTINE ED_HD_InputOutputSolve( this_time, p_FAST, calcJacobian & CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) u_perturb = u CALL Perturb_u( i, u_perturb, y_ED_perturb=y_ED_perturb, perturb=ThisPerturb ) ! perturb u and y_ED by ThisPerturb [routine sets ThisPerturb] - CALL Transfer_ED_to_HD( y_ED_perturb, u_HD_perturb, MeshMapData, ErrStat2, ErrMsg2 ) ! get u_HD_perturb + CALL Transfer_PlatformMotion_to_HD( y_ED_perturb%PlatformPtMesh, u_HD_perturb, MeshMapData, ErrStat2, ErrMsg2 ) ! get u_HD_perturb CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! calculate outputs with perturbed inputs: @@ -1544,7 +1622,7 @@ SUBROUTINE ED_HD_InputOutputSolve( this_time, p_FAST, calcJacobian & MeshMapData%Jacobian_Opt1(:,i) = (Fn_U_perturb - Fn_U_Resid) / ThisPerturb END DO ! HydroDyn contribution ( columns 7-12 ) - + #ifdef OUTPUT_ADDEDMASS UnAM = -1 CALL GetNewUnit( UnAM, ErrStat, ErrMsg ) @@ -1629,10 +1707,9 @@ SUBROUTINE ED_HD_InputOutputSolve( this_time, p_FAST, calcJacobian & y_ED_input%PlatformPtMesh%TranslationAcc(:,1) = y_ED_input%PlatformPtMesh%TranslationAcc(:,1) + u_delta( 7: 9) y_ED_input%PlatformPtMesh%RotationAcc( :,1) = y_ED_input%PlatformPtMesh%RotationAcc( :,1) + u_delta(10:12) - CALL Transfer_ED_to_HD( y_ED_input, u_HD, MeshMapData, ErrStat2, ErrMsg2 ) ! get u_HD with u_delta changes + CALL Transfer_PlatformMotion_to_HD( y_ED_input%PlatformPtMesh, u_HD, MeshMapData, ErrStat2, ErrMsg2 ) ! get u_HD with u_delta changes CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - K = K + 1 END DO ! K @@ -1682,14 +1759,15 @@ END SUBROUTINE Perturb_u SUBROUTINE U_ED_HD_Residual( y_ED2, y_HD2, u_IN, U_Resid) !............................................................................................................................... - TYPE(ED_OutputType) , INTENT(IN ) :: y_ED2 ! System outputs + TYPE(ED_OutputType), TARGET , INTENT(IN ) :: y_ED2 ! System outputs TYPE(HydroDyn_OutputType) , INTENT(IN ) :: y_HD2 ! System outputs REAL(ReKi) , INTENT(IN ) :: u_in(NumInputs) REAL(ReKi) , INTENT( OUT) :: U_Resid(NumInputs) - - + TYPE(MeshType), POINTER :: PlatformMotions + PlatformMotions => y_ED2%PlatformPtMesh + ! ! Transfer motions: !.................. @@ -1700,46 +1778,45 @@ SUBROUTINE U_ED_HD_Residual( y_ED2, y_HD2, u_IN, U_Resid) ! note: MAP_InputSolve must be called before setting ED loads inputs (so that motions are known for loads [moment] mapping) CALL MAP_InputSolve( u_map, y_ED2, MeshMapData, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Transfer_Point_to_Point( y_MAP%PtFairleadLoad, MeshMapData%u_ED_PlatformPtMesh_2, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, u_MAP%PtFairDisplacement, y_ED2%PlatformPtMesh ) !u_MAP and y_ED contain the displacements needed for moment calculations - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL Transfer_Point_to_Point( y_MAP%PtFairleadLoad, MeshMapData%u_ED_PlatformPtMesh_2, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, u_MAP%PtFairDisplacement, PlatformMotions ) !u_MAP and y_ED contain the displacements needed for moment calculations + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN ! note: MD_InputSolve must be called before setting ED loads inputs (so that motions are known for loads [moment] mapping) CALL MD_InputSolve( u_MD, y_ED2, MeshMapData, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Transfer_Point_to_Point( y_MD%PtFairleadLoad, MeshMapData%u_ED_PlatformPtMesh_2, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, u_MD%PtFairleadDisplacement, y_ED2%PlatformPtMesh ) !u_MD and y_ED contain the displacements needed for moment calculations - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL Transfer_Point_to_Point( y_MD%PtFairleadLoad, MeshMapData%u_ED_PlatformPtMesh_2, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, u_MD%PtFairleadDisplacement, PlatformMotions ) !u_MD and y_ED contain the displacements needed for moment calculations + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN ! note: FEAM_InputSolve must be called before setting ED loads inputs (so that motions are known for loads [moment] mapping) CALL FEAM_InputSolve( u_FEAM, y_ED2, MeshMapData, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL Transfer_Point_to_Point( y_FEAM%PtFairleadLoad, MeshMapData%u_ED_PlatformPtMesh_2, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, u_FEAM%PtFairleadDisplacement, y_ED2%PlatformPtMesh ) !u_FEAM and y_ED contain the displacements needed for moment calculations - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL Transfer_Point_to_Point( y_FEAM%PtFairleadLoad, MeshMapData%u_ED_PlatformPtMesh_2, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, u_FEAM%PtFairleadDisplacement, PlatformMotions ) !u_FEAM and y_ED contain the displacements needed for moment calculations + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSE MeshMapData%u_ED_PlatformPtMesh_2%Force = 0.0_ReKi MeshMapData%u_ED_PlatformPtMesh_2%Moment = 0.0_ReKi - END IF + END IF ! we use copies of the input meshes (we don't need to update values in the original data structures): !bjj: why don't we update u_HD2 here? shouldn't we update before using it to transfer the loads? - CALL Transfer_Point_to_Point( y_ED2%PlatformPtMesh, MeshMapData%u_HD_Mesh, MeshMapData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - + CALL Transfer_Point_to_Point( PlatformMotions, MeshMapData%u_HD_Mesh, MeshMapData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! we're mapping loads, so we also need the sibling meshes' displacements: - CALL Transfer_Point_to_Point( y_HD2%AllHdroOrigin, MeshMapData%u_ED_PlatformPtMesh, MeshMapData%HD_W_P_2_ED_P, ErrStat2, ErrMsg2, MeshMapData%u_HD_Mesh, y_ED2%PlatformPtMesh) !u_HD and u_mapped_positions contain the displaced positions for load calculations + CALL Transfer_Point_to_Point( y_HD2%AllHdroOrigin, MeshMapData%u_ED_PlatformPtMesh, MeshMapData%HD_W_P_2_ED_P, ErrStat2, ErrMsg2, MeshMapData%u_HD_Mesh, PlatformMotions) !u_HD and u_mapped_positions contain the displaced positions for load calculations CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) MeshMapData%u_ED_PlatformPtMesh%Force = MeshMapData%u_ED_PlatformPtMesh%Force + MeshMapData%u_ED_PlatformPtMesh_2%Force @@ -1747,10 +1824,12 @@ SUBROUTINE U_ED_HD_Residual( y_ED2, y_HD2, u_IN, U_Resid) U_Resid( 1: 3) = u_in( 1: 3) - MeshMapData%u_ED_PlatformPtMesh%Force(:,1) / p_FAST%UJacSclFact - U_Resid( 4: 6) = u_in( 4: 6) - MeshMapData%u_ED_PlatformPtMesh%Moment(:,1) / p_FAST%UJacSclFact - U_Resid( 7: 9) = u_in( 7: 9) - y_ED2%PlatformPtMesh%TranslationAcc(:,1) - U_Resid(10:12) = u_in(10:12) - y_ED2%PlatformPtMesh%RotationAcc(:,1) - + U_Resid( 4: 6) = u_in( 4: 6) - MeshMapData%u_ED_PlatformPtMesh%Moment(:,1) / p_FAST%UJacSclFact + + U_Resid( 7: 9) = u_in( 7: 9) - PlatformMotions%TranslationAcc(:,1) + U_Resid(10:12) = u_in(10:12) - PlatformMotions%RotationAcc(:,1) + + PlatformMotions => NULL() END SUBROUTINE U_ED_HD_Residual !............................................................................................................................... @@ -1793,7 +1872,7 @@ SUBROUTINE FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & , u_MD, y_MD & , u_IceF, y_IceF & , u_IceD, y_IceD & - , MeshMapData , ErrStat, ErrMsg ) + , MeshMapData , ErrStat, ErrMsg, WriteThisStep ) !.................................................................................................................................. USE ElastoDyn @@ -1815,7 +1894,7 @@ SUBROUTINE FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & TYPE(ED_OtherStateType) , INTENT(IN ) :: OtherSt_ED !< Other states TYPE(ED_ParameterType) , INTENT(IN ) :: p_ED !< Parameters TYPE(ED_InputType) , INTENT(INOUT) :: u_ED !< System inputs - TYPE(ED_OutputType) , INTENT(INOUT) :: y_ED !< System outputs + TYPE(ED_OutputType), TARGET , INTENT(INOUT) :: y_ED !< System outputs TYPE(ED_MiscVarType) , INTENT(INOUT) :: m_ED !< misc/optimization variables !BeamDyn (one instance per blade): @@ -1884,6 +1963,7 @@ SUBROUTINE FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & TYPE(FAST_ModuleMapType) , INTENT(INOUT) :: MeshMapData !< data for mapping meshes between modules INTEGER(IntKi) , INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*) , INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + LOGICAL , INTENT(IN ) :: WriteThisStep !< Will we print the WriteOutput values this step? ! Local variables: REAL(ReKi), PARAMETER :: TOL_Squared = (1.0E-4)**2 !not currently used because KMax = 1 @@ -1918,6 +1998,8 @@ SUBROUTINE FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None + TYPE(MeshType), POINTER :: PlatformMotionMesh + #ifdef OUTPUT_ADDEDMASS REAL(ReKi) :: AddedMassMatrix(6,6) INTEGER :: UnAM @@ -1928,7 +2010,8 @@ SUBROUTINE FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & INTEGER :: TmpIndx #endif - + LOGICAL :: GetWriteOutput ! flag to determine if we need WriteOutputs from this call to CalcOutput + ! Note: p_FAST%UJacSclFact is a scaling factor that gets us similar magnitudes between loads and accelerations... !bjj: note, that this routine may have a problem if there is remapping done @@ -2020,6 +2103,7 @@ SUBROUTINE FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & !------------------------------------------------------------------------------------------------- ! Calculate outputs at this_time, based on inputs at this_time !------------------------------------------------------------------------------------------------- + GetWriteOutput = WriteThisStep .and. K >= p_FAST%KMax ! we need this only on the last call to BD CALL ED_CalcOutput( this_time, u_ED, p_ED, x_ED, xd_ED, z_ED, OtherSt_ED, y_ED, m_ED, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -2038,9 +2122,9 @@ SUBROUTINE FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF - IF ( p_FAST%CompElast == Module_BD .and. BD_Solve_Option1) THEN + IF ( p_FAST%CompElast == Module_BD .and. BD_Solve_Option1) THEN do nb=1,p_FAST%nBeams - CALL BD_CalcOutput( this_time, u_BD(nb), p_BD(nb), x_BD(nb), xd_BD(nb), z_BD(nb), OtherSt_BD(nb), y_BD(nb), m_BD(nb), ErrStat2, ErrMsg2 ) + CALL BD_CalcOutput( this_time, u_BD(nb), p_BD(nb), x_BD(nb), xd_BD(nb), z_BD(nb), OtherSt_BD(nb), y_BD(nb), m_BD(nb), ErrStat2, ErrMsg2, GetWriteOutput ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) end do END IF @@ -2072,12 +2156,14 @@ SUBROUTINE FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & END IF IF ( calcJacobian ) THEN + i = 0 !............................... ! Get ElastoDyn's contribution: !............................... - DO i=1,p_FAST%SizeJac_Opt1(2) !call ED_CalcOutput - + DO j=1,p_FAST%SizeJac_Opt1(2) !call ED_CalcOutput + i = i + 1 + ! perturb u_ED: CALL ED_CopyInput( u_ED, u_ED_perturb, MESH_UPDATECOPY, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -2101,7 +2187,6 @@ SUBROUTINE FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & END DO ! ElastoDyn contribution ( columns 1-p_FAST%SizeJac_Opt1(2) ) - i = p_FAST%SizeJac_Opt1(2) !............................... ! Get SubDyn's contribution: (note if p_FAST%CompSub /= Module_SD, SizeJac_Opt1(3) = 0) !............................... @@ -2184,7 +2269,7 @@ SUBROUTINE FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & CALL Perturb_u_FullOpt1( p_FAST, MeshMapData%Jac_u_indx, i, u_perturb, u_BD_perturb=u_BD_perturb, perturb=ThisPerturb ) ! perturb u and u_HD by ThisPerturb [routine sets ThisPerturb] ! calculate outputs with perturbed inputs: - CALL BD_CalcOutput( this_time, u_BD_perturb, p_BD(nb), x_BD(nb), xd_BD(nb), z_BD(nb), OtherSt_BD(nb), y_BD_perturb(nb), m_BD(nb), ErrStat2, ErrMsg2 ) + CALL BD_CalcOutput( this_time, u_BD_perturb, p_BD(nb), x_BD(nb), xd_BD(nb), z_BD(nb), OtherSt_BD(nb), y_BD_perturb(nb), m_BD(nb), ErrStat2, ErrMsg2, .false. ) ! We don't use the WriteOutput when computing the Jacobian CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL U_FullOpt1_Residual(y_ED, y_SD, y_HD, y_BD_perturb, y_Orca, y_ExtPtfm, u_perturb, Fn_U_perturb) ! get this perturbation @@ -2202,7 +2287,7 @@ SUBROUTINE FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & !............................... ! Get OrcaFlex's contribution: (note if p_FAST%CompMooring /= Module_Orca, SizeJac_Opt1(8) = 0) - !............................... + !............................... DO j=1,p_FAST%SizeJac_Opt1(8) !call Orca_CalcOutput i = i + 1 @@ -2436,6 +2521,9 @@ SUBROUTINE FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & ! This is effectively doing option 2, where we set the input velocities and displacements based on the outputs we just calculated !............................................... + PlatformMotionMesh => y_ED%PlatformPtMesh + + ! BD motion inputs: (from ED) IF (p_FAST%CompElast == Module_BD .and. BD_Solve_Option1) THEN @@ -2485,12 +2573,12 @@ SUBROUTINE FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & ! Map ED outputs to HD inputs (keeping the accelerations we just calculated): - CALL Transfer_Point_to_Point( y_ED%PlatformPtMesh, u_HD%Mesh, MeshMapData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2 ) + CALL Transfer_Point_to_Point( PlatformMotionMesh, u_HD%Mesh, MeshMapData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSE - CALL Transfer_ED_to_HD( y_ED, u_HD, MeshMapData, ErrStat2, ErrMsg2 ) + CALL Transfer_PlatformMotion_to_HD( PlatformMotionMesh, u_HD, MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF @@ -2523,7 +2611,7 @@ SUBROUTINE FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & MeshMapData%u_SD_TPMesh%RotationAcc = u_SD%TPMesh%RotationAcc MeshMapData%u_SD_TPMesh%TranslationAcc = u_SD%TPMesh%TranslationAcc - CALL Transfer_Point_to_Point( y_ED%PlatformPtMesh, u_SD%TPMesh, MeshMapData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) + CALL Transfer_Point_to_Point( PlatformMotionMesh, u_SD%TPMesh, MeshMapData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -2539,7 +2627,7 @@ SUBROUTINE FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & MeshMapData%u_ExtPtfm_PtfmMesh%RotationAcc = u_ExtPtfm%PtfmMesh%RotationAcc MeshMapData%u_ExtPtfm_PtfmMesh%TranslationAcc = u_ExtPtfm%PtfmMesh%TranslationAcc - CALL Transfer_Point_to_Point( y_ED%PlatformPtMesh, u_ExtPtfm%PtfmMesh, MeshMapData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) + CALL Transfer_Point_to_Point( PlatformMotionMesh, u_ExtPtfm%PtfmMesh, MeshMapData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) u_ExtPtfm%PtfmMesh%RotationAcc = MeshMapData%u_ExtPtfm_PtfmMesh%RotationAcc @@ -2556,7 +2644,7 @@ SUBROUTINE FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & MeshMapData%u_Orca_PtfmMesh%RotationAcc = u_Orca%PtfmMesh%RotationAcc MeshMapData%u_Orca_PtfmMesh%TranslationAcc = u_Orca%PtfmMesh%TranslationAcc - CALL Transfer_Point_to_Point( y_ED%PlatformPtMesh, u_Orca%PtfmMesh, MeshMapData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) + CALL Transfer_Point_to_Point( PlatformMotionMesh, u_Orca%PtfmMesh, MeshMapData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) u_Orca%PtfmMesh%RotationAcc = MeshMapData%u_Orca_PtfmMesh%RotationAcc @@ -2574,7 +2662,7 @@ SUBROUTINE U_FullOpt1_Residual( y_ED2, y_SD2, y_HD2, y_BD2, y_Orca2, y_ExtPtfm2, ! transfer outputs of ED, HD, SD, BD, and OrcaFlex (and any additional loads that get summed with them) into inputs for ED, HD, SD, BD, and OrcaFlex !............................................................................................................................... - TYPE(ED_OutputType) , INTENT(IN ) :: y_ED2 ! System outputs + TYPE(ED_OutputType), TARGET , INTENT(IN ) :: y_ED2 ! System outputs TYPE(SD_OutputType) , INTENT(IN ) :: y_SD2 ! System outputs TYPE(HydroDyn_OutputType) , INTENT(IN ) :: y_HD2 ! System outputs TYPE(BD_OutputType) , INTENT(IN ) :: y_BD2(:) ! System outputs @@ -2584,6 +2672,9 @@ SUBROUTINE U_FullOpt1_Residual( y_ED2, y_SD2, y_HD2, y_BD2, y_Orca2, y_ExtPtfm2, REAL(ReKi) , INTENT( OUT) :: U_Resid(:) INTEGER(IntKi) :: i ! counter for ice leg and beamdyn loops + TYPE(MeshType), POINTER :: PlatformMotions + + PlatformMotions => y_ED2%PlatformPtMesh !.................. ! Set mooring line and ice inputs (which don't have acceleration fields and aren't used elsewhere in this routine, thus we're using the actual inputs (not a copy) @@ -2612,7 +2703,7 @@ SUBROUTINE U_FullOpt1_Residual( y_ED2, y_SD2, y_HD2, y_BD2, y_Orca2, y_ExtPtfm2, ! Map ED motion output to Orca inputs: ! note: must be called before setting ED loads inputs (so that Orca motions are known for loads [moment] mapping) - CALL Transfer_Point_to_Point( y_ED2%PlatformPtMesh, MeshMapData%u_Orca_PtfmMesh, MeshMapData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) + CALL Transfer_Point_to_Point( PlatformMotions, MeshMapData%u_Orca_PtfmMesh, MeshMapData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) END IF @@ -2673,7 +2764,7 @@ SUBROUTINE U_FullOpt1_Residual( y_ED2, y_SD2, y_HD2, y_BD2, y_Orca2, y_ExtPtfm2, ! Map ED motion output to HD inputs: - CALL Transfer_Point_to_Point( y_ED2%PlatformPtMesh, MeshMapData%u_HD_Mesh, MeshMapData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2 ) + CALL Transfer_Point_to_Point( PlatformMotions, MeshMapData%u_HD_Mesh, MeshMapData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) !.................. @@ -2741,7 +2832,7 @@ SUBROUTINE U_FullOpt1_Residual( y_ED2, y_SD2, y_HD2, y_BD2, y_Orca2, y_ExtPtfm2, !.................. ! Motions (outputs) at ED platform ref point transfered to SD transition piece (input): - CALL Transfer_Point_to_Point( y_ED2%PlatformPtMesh, MeshMapData%u_SD_TPMesh, MeshMapData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) + CALL Transfer_Point_to_Point( PlatformMotions, MeshMapData%u_SD_TPMesh, MeshMapData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) !.................. @@ -2750,14 +2841,14 @@ SUBROUTINE U_FullOpt1_Residual( y_ED2, y_SD2, y_HD2, y_BD2, y_Orca2, y_ExtPtfm2, ! Loads (outputs) on the SD transition piece transfered to ED input location/mesh: ! we're mapping loads, so we also need the sibling meshes' displacements: - CALL Transfer_Point_to_Point( y_SD2%Y1Mesh, MeshMapData%u_ED_PlatformPtMesh, MeshMapData%SD_TP_2_ED_P, ErrStat2, ErrMsg2, MeshMapData%u_SD_TPMesh, y_ED2%PlatformPtMesh ) !MeshMapData%u_SD_TPMesh contains the orientations needed for moment calculations + CALL Transfer_Point_to_Point( y_SD2%Y1Mesh, MeshMapData%u_ED_PlatformPtMesh, MeshMapData%SD_TP_2_ED_P, ErrStat2, ErrMsg2, MeshMapData%u_SD_TPMesh, PlatformMotions ) !MeshMapData%u_SD_TPMesh contains the orientations needed for moment calculations CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) ! WAMIT loads from HD get added to this load: IF ( y_HD2%Mesh%Committed ) THEN ! we're mapping loads, so we also need the sibling meshes' displacements: - CALL Transfer_Point_to_Point( y_HD2%Mesh, MeshMapData%u_ED_PlatformPtMesh_2, MeshMapData%HD_W_P_2_ED_P, ErrStat2, ErrMsg2, MeshMapData%u_HD_Mesh, y_ED2%PlatformPtMesh ) !u_SD contains the orientations needed for moment calculations + CALL Transfer_Point_to_Point( y_HD2%Mesh, MeshMapData%u_ED_PlatformPtMesh_2, MeshMapData%HD_W_P_2_ED_P, ErrStat2, ErrMsg2, MeshMapData%u_HD_Mesh, PlatformMotions ) !u_SD contains the orientations needed for moment calculations CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) MeshMapData%u_ED_PlatformPtMesh%Force = MeshMapData%u_ED_PlatformPtMesh%Force + MeshMapData%u_ED_PlatformPtMesh_2%Force @@ -2772,7 +2863,7 @@ SUBROUTINE U_FullOpt1_Residual( y_ED2, y_SD2, y_HD2, y_BD2, y_Orca2, y_ExtPtfm2, !.................. ! Motions (outputs) at ED platform ref point transfered to ExtPtfm PtfmMesh (input): - CALL Transfer_Point_to_Point( y_ED2%PlatformPtMesh, MeshMapData%u_ExtPtfm_PtfmMesh, MeshMapData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) + CALL Transfer_Point_to_Point( PlatformMotions, MeshMapData%u_ExtPtfm_PtfmMesh, MeshMapData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) !.................. @@ -2781,8 +2872,8 @@ SUBROUTINE U_FullOpt1_Residual( y_ED2, y_SD2, y_HD2, y_BD2, y_Orca2, y_ExtPtfm2, ! Loads (outputs) on the ExtPtfm platform mesh transfered to ED input location/mesh: ! we're mapping loads, so we also need the sibling meshes' displacements: - CALL Transfer_Point_to_Point( y_ExtPtfm2%PtfmMesh, MeshMapData%u_ED_PlatformPtMesh, MeshMapData%SD_TP_2_ED_P, ErrStat2, ErrMsg2, MeshMapData%u_ExtPtfm_PtfmMesh, y_ED2%PlatformPtMesh ) - CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) + CALL Transfer_Point_to_Point( y_ExtPtfm2%PtfmMesh, MeshMapData%u_ED_PlatformPtMesh, MeshMapData%SD_TP_2_ED_P, ErrStat2, ErrMsg2, MeshMapData%u_ExtPtfm_PtfmMesh, PlatformMotions ) + CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) ELSE IF ( p_FAST%CompHydro == Module_HD ) THEN @@ -2791,24 +2882,24 @@ SUBROUTINE U_FullOpt1_Residual( y_ED2, y_SD2, y_HD2, y_BD2, y_Orca2, y_ExtPtfm2, !.................. ! Map ED motion outputs to HD inputs: - ! basically, we want to call Transfer_ED_to_HD, except we have the meshes in a different data structure (not a copy of u_HD) - ! CALL Transfer_ED_to_HD( y_ED2, u_HD, MeshMapData, ErrStat2, ErrMsg2 ) + ! basically, we want to call Transfer_PlatformMotion_to_HD, except we have the meshes in a different data structure (not a copy of u_HD) + ! CALL Transfer_PlatformMotion_to_HD( y_ED2%PlatformPtMesh, u_HD, MeshMapData, ErrStat2, ErrMsg2 ) ! so, here are the transfers, again. ! These are the motions for the lumped point loads associated the WAMIT body: - CALL Transfer_Point_to_Point( y_ED2%PlatformPtMesh, MeshMapData%u_HD_Mesh, MeshMapData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2 ) + CALL Transfer_Point_to_Point( PlatformMotions, MeshMapData%u_HD_Mesh, MeshMapData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) ! These are the motions for the lumped point loads associated viscous drag on the WAMIT body and/or filled/flooded lumped forces of the WAMIT body if (MeshMapData%u_HD_M_LumpedMesh%Committed) then - CALL Transfer_Point_to_Point( y_ED2%PlatformPtMesh, MeshMapData%u_HD_M_LumpedMesh, MeshMapData%ED_P_2_HD_M_P, ErrStat2, ErrMsg2 ) + CALL Transfer_Point_to_Point( PlatformMotions, MeshMapData%u_HD_M_LumpedMesh, MeshMapData%ED_P_2_HD_M_P, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) endif ! These are the motions for the line2 (distributed) loads associated viscous drag on the WAMIT body and/or filled/flooded distributed forces of the WAMIT body if (MeshMapData%u_HD_M_DistribMesh%Committed) then - CALL Transfer_Point_to_Line2( y_ED2%PlatformPtMesh, MeshMapData%u_HD_M_DistribMesh, MeshMapData%ED_P_2_HD_M_L, ErrStat2, ErrMsg2 ) + CALL Transfer_Point_to_Line2( PlatformMotions, MeshMapData%u_HD_M_DistribMesh, MeshMapData%ED_P_2_HD_M_L, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) endif @@ -2817,7 +2908,7 @@ SUBROUTINE U_FullOpt1_Residual( y_ED2, y_SD2, y_HD2, y_BD2, y_Orca2, y_ExtPtfm2, !.................. ! we're mapping loads, so we also need the sibling meshes' displacements: - CALL Transfer_Point_to_Point( y_HD2%AllHdroOrigin, MeshMapData%u_ED_PlatformPtMesh, MeshMapData%HD_W_P_2_ED_P, ErrStat2, ErrMsg2, MeshMapData%u_HD_Mesh, y_ED2%PlatformPtMesh) !u_HD and u_mapped_positions contain the displaced positions for load calculations + CALL Transfer_Point_to_Point( y_HD2%AllHdroOrigin, MeshMapData%u_ED_PlatformPtMesh, MeshMapData%HD_W_P_2_ED_P, ErrStat2, ErrMsg2, MeshMapData%u_HD_Mesh, PlatformMotions) !u_HD and u_mapped_positions contain the displaced positions for load calculations CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) ELSE @@ -2836,28 +2927,28 @@ SUBROUTINE U_FullOpt1_Residual( y_ED2, y_SD2, y_HD2, y_BD2, y_Orca2, y_ExtPtfm2, ! Get the loads for ED from a mooring module and add them: IF ( p_FAST%CompMooring == Module_MAP ) THEN - CALL Transfer_Point_to_Point( y_MAP%PtFairleadLoad, MeshMapData%u_ED_PlatformPtMesh_2, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, u_MAP%PtFairDisplacement, y_ED2%PlatformPtMesh ) !u_MAP and y_ED contain the displacements needed for moment calculations + CALL Transfer_Point_to_Point( y_MAP%PtFairleadLoad, MeshMapData%u_ED_PlatformPtMesh_2, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, u_MAP%PtFairDisplacement, PlatformMotions ) !u_MAP and y_ED contain the displacements needed for moment calculations CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) MeshMapData%u_ED_PlatformPtMesh%Force = MeshMapData%u_ED_PlatformPtMesh%Force + MeshMapData%u_ED_PlatformPtMesh_2%Force MeshMapData%u_ED_PlatformPtMesh%Moment = MeshMapData%u_ED_PlatformPtMesh%Moment + MeshMapData%u_ED_PlatformPtMesh_2%Moment ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN - CALL Transfer_Point_to_Point( y_MD%PtFairleadLoad, MeshMapData%u_ED_PlatformPtMesh_2, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, u_MD%PtFairleadDisplacement, y_ED2%PlatformPtMesh ) !u_MD and y_ED contain the displacements needed for moment calculations + CALL Transfer_Point_to_Point( y_MD%PtFairleadLoad, MeshMapData%u_ED_PlatformPtMesh_2, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, u_MD%PtFairleadDisplacement, PlatformMotions ) !u_MD and y_ED contain the displacements needed for moment calculations CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) MeshMapData%u_ED_PlatformPtMesh%Force = MeshMapData%u_ED_PlatformPtMesh%Force + MeshMapData%u_ED_PlatformPtMesh_2%Force MeshMapData%u_ED_PlatformPtMesh%Moment = MeshMapData%u_ED_PlatformPtMesh%Moment + MeshMapData%u_ED_PlatformPtMesh_2%Moment ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN - CALL Transfer_Point_to_Point( y_FEAM%PtFairleadLoad, MeshMapData%u_ED_PlatformPtMesh_2, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, u_FEAM%PtFairleadDisplacement, y_ED2%PlatformPtMesh ) !u_FEAM and y_ED contain the displacements needed for moment calculations + CALL Transfer_Point_to_Point( y_FEAM%PtFairleadLoad, MeshMapData%u_ED_PlatformPtMesh_2, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, u_FEAM%PtFairleadDisplacement, PlatformMotions ) !u_FEAM and y_ED contain the displacements needed for moment calculations CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) MeshMapData%u_ED_PlatformPtMesh%Force = MeshMapData%u_ED_PlatformPtMesh%Force + MeshMapData%u_ED_PlatformPtMesh_2%Force MeshMapData%u_ED_PlatformPtMesh%Moment = MeshMapData%u_ED_PlatformPtMesh%Moment + MeshMapData%u_ED_PlatformPtMesh_2%Moment ELSEIF ( p_FAST%CompMooring == Module_Orca ) THEN - CALL Transfer_Point_to_Point( y_Orca2%PtfmMesh, MeshMapData%u_ED_PlatformPtMesh_2, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, MeshMapData%u_Orca_PtfmMesh, y_ED2%PlatformPtMesh ) !u_Orca_PtfmMesh and y_ED contain the displacements needed for moment calculations + CALL Transfer_Point_to_Point( y_Orca2%PtfmMesh, MeshMapData%u_ED_PlatformPtMesh_2, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, MeshMapData%u_Orca_PtfmMesh, PlatformMotions ) !u_Orca_PtfmMesh and y_ED contain the displacements needed for moment calculations CALL SetErrStat(ErrStat2,ErrMsg2, ErrStat, ErrMsg, RoutineName) MeshMapData%u_ED_PlatformPtMesh%Force = MeshMapData%u_ED_PlatformPtMesh%Force + MeshMapData%u_ED_PlatformPtMesh_2%Force @@ -2875,6 +2966,7 @@ SUBROUTINE U_FullOpt1_Residual( y_ED2, y_SD2, y_HD2, y_BD2, y_Orca2, y_ExtPtfm2, U_Resid = u_in - U_Resid + PlatformMotions => NULL() END SUBROUTINE U_FullOpt1_Residual !............................................................................................................................... @@ -2957,6 +3049,7 @@ SUBROUTINE Init_FullOpt1_Jacobian( p_FAST, MeshMapData, ED_PlatformPtMesh, SD_TP ErrMsg = "" ! determine how many inputs there are between the 6 modules (ED, SD, HD, BD, Orca, ExtPtfm) + p_FAST%SizeJac_Opt1 = 0 ! initialize whole array if (p_FAST%CompHydro == Module_HD .or. p_FAST%CompSub /= Module_None .or. p_FAST%CompMooring == Module_Orca) then p_FAST%SizeJac_Opt1(2) = ED_PlatformPtMesh%NNodes*6 ! ED inputs: 3 forces and 3 moments per node (only 1 node) @@ -2965,10 +3058,10 @@ SUBROUTINE Init_FullOpt1_Jacobian( p_FAST, MeshMapData, ED_PlatformPtMesh, SD_TP end if - p_FAST%SizeJac_Opt1(3) = SD_TPMesh%NNodes*6 ! SD inputs: 6 accelerations per node (size of SD input from ED) + p_FAST%SizeJac_Opt1(3) = SD_TPMesh%NNodes*6 ! SD inputs: 6 accelerations per node (size of SD input from ED) IF ( p_FAST%CompHydro == Module_HD ) THEN p_FAST%SizeJac_Opt1(3) = p_FAST%SizeJac_Opt1(3) & - + SD_LMesh%NNodes *6 ! SD inputs: 6 loads per node (size of SD input from HD) + + SD_LMesh%NNodes *6 ! SD inputs: 6 loads per node (size of SD input from HD) END IF p_FAST%SizeJac_Opt1(4) = HD_M_LumpedMesh%NNodes *6 & ! HD inputs: 6 accelerations per node (on each Morison mesh) @@ -2981,7 +3074,7 @@ SUBROUTINE Init_FullOpt1_Jacobian( p_FAST, MeshMapData, ED_PlatformPtMesh, SD_TP p_FAST%SizeJac_Opt1(5:7) = 0 ! assumes a max of 3 blades do k=1,size(u_BD) - p_FAST%SizeJac_Opt1(4+k) = u_BD(k)%RootMotion%NNodes *6 ! BD inputs: 6 accelerations per node (size of BD input from ED) + p_FAST%SizeJac_Opt1(4+k) = u_BD(k)%RootMotion%NNodes *6 ! BD inputs: 6 accelerations per node (size of BD input from ED) end do END IF @@ -3537,7 +3630,7 @@ SUBROUTINE Perturb_u_FullOpt1( p_FAST, Jac_u_indx, n, u_perturb, u_ED_perturb, u INTEGER( IntKi ) , INTENT(IN ) :: Jac_u_indx(:,:) !< Index to map Jacobian u-vector into mesh fields INTEGER( IntKi ) , INTENT(IN ) :: n !< number of array element to use REAL( ReKi ) , INTENT(INOUT) :: u_perturb(:) !< array to be perturbed - TYPE(ED_InputType), OPTIONAL , INTENT(INOUT) :: u_ED_perturb !< ED System inputs (needed only when 1 <= n <= NumEDNodes) + TYPE(ED_InputType), OPTIONAL , INTENT(INOUT) :: u_ED_perturb !< ED System inputs (needed only when 1 <= n <= NumEDNodes=NumEDNodes) TYPE(SD_InputType), OPTIONAL , INTENT(INOUT) :: u_SD_perturb !< SD System inputs (needed only when NumEDNodes +1 <= n <= NumEDNodes+NumSDNodes) [if SD is used] TYPE(HydroDyn_InputType), OPTIONAL , INTENT(INOUT) :: u_HD_perturb !< HD System inputs (needed only when NumEDNodes+NumSDNodes +1 <= n <= NumEDNodes+NumSDNodes+NumHDNodes) [if HD is used and SD is used. if SD not used, TYPE(BD_InputType), OPTIONAL , INTENT(INOUT) :: u_BD_perturb !< BD System inputs (needed only when NumEDNodes+NumSDNodes+NumHDNodes+1 <= n <= inf) [if BD is used] @@ -3673,23 +3766,23 @@ SUBROUTINE ResetRemapFlags(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, MAPp ! ElastoDyn meshes ED%Input( 1)%PlatformPtMesh%RemapFlag = .FALSE. - ED%Output(1)%PlatformPtMesh%RemapFlag = .FALSE. + ED%y%PlatformPtMesh%RemapFlag = .FALSE. ED%Input( 1)%TowerPtLoads%RemapFlag = .FALSE. - ED%Output(1)%TowerLn2Mesh%RemapFlag = .FALSE. - DO K=1,SIZE(ED%Output(1)%BladeRootMotion) - ED%Output(1)%BladeRootMotion(K)%RemapFlag = .FALSE. + ED%y%TowerLn2Mesh%RemapFlag = .FALSE. + DO K=1,SIZE(ED%y%BladeRootMotion) + ED%y%BladeRootMotion(K)%RemapFlag = .FALSE. END DO if (allocated(ED%Input(1)%BladePtLoads)) then DO K=1,SIZE(ED%Input(1)%BladePtLoads) ED%Input( 1)%BladePtLoads(K)%RemapFlag = .FALSE. - ED%Output(1)%BladeLn2Mesh(K)%RemapFlag = .FALSE. + ED%y%BladeLn2Mesh(K)%RemapFlag = .FALSE. END DO end if - ED%Input( 1)%NacelleLoads%RemapFlag = .FALSE. - ED%Output(1)%NacelleMotion%RemapFlag = .FALSE. - ED%Input( 1)%HubPtLoad%RemapFlag = .FALSE. - ED%Output(1)%HubPtMotion%RemapFlag = .FALSE. + ED%Input( 1)%NacelleLoads%RemapFlag = .FALSE. + ED%y%NacelleMotion%RemapFlag = .FALSE. + ED%Input( 1)%HubPtLoad%RemapFlag = .FALSE. + ED%y%HubPtMotion%RemapFlag = .FALSE. ! BeamDyn meshes IF ( p_FAST%CompElast == Module_BD ) THEN @@ -3823,40 +3916,46 @@ END SUBROUTINE ResetRemapFlags SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg) !............................................................................................................................... - TYPE(FAST_ParameterType), INTENT(INOUT) :: p_FAST !< Parameters for the glue code + TYPE(FAST_ParameterType), INTENT(INOUT) :: p_FAST !< Parameters for the glue code - TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data - TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data - TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data - TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data - TYPE(AeroDyn14_Data), INTENT(INOUT) :: AD14 !< AeroDyn14 data - TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data - TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data - TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm data - TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data - TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data - TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< MoorDyn data - TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data - TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data - TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop + TYPE(ElastoDyn_Data),TARGET,INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(AeroDyn14_Data), INTENT(INOUT) :: AD14 !< AeroDyn14 data + TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data + TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm data + TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data + TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< MoorDyn data + TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data + TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data + TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop - TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules - INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - INTEGER :: K, i ! loop counters - INTEGER :: NumBl ! number of blades - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMSg2 - CHARACTER(*), PARAMETER :: RoutineName = 'InitModuleMappings' + INTEGER :: K, i ! loop counters + INTEGER :: NumBl ! number of blades + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMSg2 + CHARACTER(*), PARAMETER :: RoutineName = 'InitModuleMappings' + + TYPE(MeshType), POINTER :: PlatformMotion + TYPE(MeshType), POINTER :: PlatformLoads !............................................................................................................................ ErrStat = ErrID_None ErrMsg = "" - NumBl = SIZE(ED%Output(1)%BladeRootMotion,1) + + NumBl = SIZE(ED%y%BladeRootMotion,1) + PlatformMotion => ED%y%PlatformPtMesh + PlatformLoads => ED%Input(1)%PlatformPtMesh !............................................................................................................................ ! Create the data structures and mappings in MeshMapType @@ -3876,7 +3975,7 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M END IF DO K=1,NumBl - CALL MeshMapCreate( ED%Output(1)%BladeRootMotion(K), BD%Input(1,k)%RootMotion, MeshMapData%ED_P_2_BD_P(K), ErrStat2, ErrMsg2 ) + CALL MeshMapCreate( ED%y%BladeRootMotion(K), BD%Input(1,k)%RootMotion, MeshMapData%ED_P_2_BD_P(K), ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_2_BD_BladeRootMotion('//TRIM(Num2LStr(K))//')' ) CALL MeshMapCreate( BD%y(k)%ReactionForce, ED%Input(1)%HubPtLoad, MeshMapData%BD_P_2_ED_P(K), ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':BD_2_ED_ReactionLoad('//TRIM(Num2LStr(K))//')' ) @@ -3890,20 +3989,20 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M END IF DO K=1,NumBl - CALL MeshMapCreate( ED%Output(1)%HubPtMotion, BD%Input(1,k)%HubMotion, MeshMapData%ED_P_2_BD_P_Hub(K), ErrStat2, ErrMsg2 ) + CALL MeshMapCreate( ED%y%HubPtMotion, BD%Input(1,k)%HubMotion, MeshMapData%ED_P_2_BD_P_Hub(K), ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_2_BD_HubMotion('//TRIM(Num2LStr(K))//')' ) END DO - + END IF - !------------------------- ! ElastoDyn <-> ServoDyn !------------------------- + IF ( SrvD%Input(1)%NTMD%Mesh%Committed ) THEN ! ED-SrvD - CALL MeshMapCreate( ED%Output(1)%NacelleMotion, SrvD%Input(1)%NTMD%Mesh, MeshMapData%ED_P_2_SrvD_P_N, ErrStat2, ErrMsg2 ) + CALL MeshMapCreate( ED%y%NacelleMotion, SrvD%Input(1)%NTMD%Mesh, MeshMapData%ED_P_2_SrvD_P_N, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_2_SrvD_NacelleMotion' ) CALL MeshMapCreate( SrvD%y%NTMD%Mesh, ED%Input(1)%NacelleLoads, MeshMapData%SrvD_P_2_ED_P_N, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':SrvD_2_ED_NacelleLoads' ) @@ -3912,13 +4011,12 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M IF ( SrvD%Input(1)%TTMD%Mesh%Committed ) THEN ! ED-SrvD - CALL MeshMapCreate( ED%Output(1)%TowerLn2Mesh, SrvD%Input(1)%TTMD%Mesh, MeshMapData%ED_L_2_SrvD_P_T, ErrStat2, ErrMsg2 ) + CALL MeshMapCreate( ED%y%TowerLn2Mesh, SrvD%Input(1)%TTMD%Mesh, MeshMapData%ED_L_2_SrvD_P_T, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_2_SrvD_TowerMotion' ) CALL MeshMapCreate( SrvD%y%TTMD%Mesh, ED%Input(1)%TowerPtLoads, MeshMapData%SrvD_P_2_ED_P_T, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':SrvD_2_ED_TowerLoad' ) - END IF - + END IF !------------------------- ! ElastoDyn <-> AeroDyn14 @@ -3942,7 +4040,7 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M ! Tower mesh: IF ( AD14%Input(1)%Twr_InputMarkers%Committed ) THEN - CALL MeshMapCreate( ED%Output(1)%TowerLn2Mesh, AD14%Input(1)%Twr_InputMarkers, MeshMapData%ED_L_2_AD_L_T, ErrStat2, ErrMsg2 ) + CALL MeshMapCreate( ED%y%TowerLn2Mesh, AD14%Input(1)%Twr_InputMarkers, MeshMapData%ED_L_2_AD_L_T, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_2_AD_TowerMotion' ) CALL MeshMapCreate( AD14%y%Twr_OutputLoads, ED%Input(1)%TowerPtLoads, MeshMapData%AD_L_2_ED_P_T, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':AD_2_ED_TowerLoad' ) @@ -3952,8 +4050,6 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M ELSEIF ( p_FAST%CompAero == Module_AD ) THEN ! ED-AD and/or BD-AD - NumBl = SIZE(AD%Input(1)%BladeRootMotion) - ! allocate per-blade space for mapping to structural module ! Blade root meshes @@ -3972,25 +4068,26 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M END IF + !------------------------- ! ElastoDyn <-> AeroDyn !------------------------- ! blade root meshes DO K=1,NumBl - CALL MeshMapCreate( ED%Output(1)%BladeRootMotion(K), AD%Input(1)%BladeRootMotion(K), MeshMapData%ED_P_2_AD_P_R(K), ErrStat2, ErrMsg2 ) + CALL MeshMapCreate( ED%y%BladeRootMotion(K), AD%Input(1)%BladeRootMotion(K), MeshMapData%ED_P_2_AD_P_R(K), ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_2_AD_RootMotion('//TRIM(Num2LStr(K))//')' ) END DO ! Hub point mesh - CALL MeshMapCreate( ED%Output(1)%HubPtMotion, AD%Input(1)%HubMotion, MeshMapData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2 ) + CALL MeshMapCreate( ED%y%HubPtMotion, AD%Input(1)%HubMotion, MeshMapData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_2_AD_HubMotion' ) ! Tower mesh: IF ( AD%Input(1)%TowerMotion%Committed ) THEN - CALL MeshMapCreate( ED%Output(1)%TowerLn2Mesh, AD%Input(1)%TowerMotion, MeshMapData%ED_L_2_AD_L_T, ErrStat2, ErrMsg2 ) + CALL MeshMapCreate( ED%y%TowerLn2Mesh, AD%Input(1)%TowerMotion, MeshMapData%ED_L_2_AD_L_T, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_2_AD_TowerMotion' ) IF ( AD%y%TowerLoad%Committed ) THEN @@ -4004,7 +4101,7 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M ! Blade meshes: DO K=1,NumBl - CALL MeshMapCreate( ED%Output(1)%BladeLn2Mesh(K), AD%Input(1)%BladeMotion(K), MeshMapData%BDED_L_2_AD_L_B(K), ErrStat2, ErrMsg2 ) + CALL MeshMapCreate( ED%y%BladeLn2Mesh(K), AD%Input(1)%BladeMotion(K), MeshMapData%BDED_L_2_AD_L_B(K), ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_2_AD_BladeMotion('//TRIM(Num2LStr(K))//')' ) CALL MeshMapCreate( AD%y%BladeLoad(K), ED%Input(1)%BladePtLoads(K), MeshMapData%AD_L_2_BDED_B(K), ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':AD_2_ED_BladeLoad('//TRIM(Num2LStr(K))//')' ) @@ -4027,8 +4124,8 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M !------------------------- ! BeamDyn <-> BeamDyn !------------------------- - if (.not. p_FAST%BD_OutputSibling) then - + if (.not. p_FAST%BD_OutputSibling) then + ! Blade meshes for load transfer: (allocate meshes at BD input locations for motions transferred from BD output locations) ALLOCATE( MeshMapData%BD_L_2_BD_L(NumBl), MeshMapData%y_BD_BldMotion_4Loads(NumBl), STAT=ErrStat2 ) IF ( ErrStat2 /= 0 ) THEN @@ -4072,42 +4169,41 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M !------------------------- ! HydroDyn <-> ElastoDyn -!------------------------- - IF ( p_FAST%CompSub /= Module_SD ) THEN ! all of these get mapped to ElastoDyn - - ! we're just going to assume ED%Input(1)%PlatformPtMesh is committed +!------------------------- + IF ( p_FAST%CompSub /= Module_SD ) THEN ! all of these get mapped to ElastoDyn ! (offshore floating) + + ! we're just going to assume PlatformLoads and PlatformMotion are committed IF ( HD%y%AllHdroOrigin%Committed ) THEN ! meshes for floating ! HydroDyn WAMIT point mesh to/from ElastoDyn point mesh - CALL MeshMapCreate( HD%y%AllHdroOrigin, ED%Input(1)%PlatformPtMesh, MeshMapData%HD_W_P_2_ED_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':HD_W_P_2_ED_P' ) - CALL MeshMapCreate( ED%Output(1)%PlatformPtMesh, HD%Input(1)%Mesh, MeshMapData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_P_2_HD_W_P' ) - END IF + CALL MeshMapCreate( HD%y%AllHdroOrigin, PlatformLoads, MeshMapData%HD_W_P_2_ED_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':HD_W_P_2_Ptfm' ) + CALL MeshMapCreate( PlatformMotion, HD%Input(1)%Mesh, MeshMapData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Ptfm_2_HD_W_P' ) + END IF ! ElastoDyn point mesh HydroDyn Morison point mesh (ED sets inputs, but gets outputs from HD%y%AllHdroOrigin in floating case) - IF ( HD%Input(1)%Morison%LumpedMesh%Committed ) THEN - CALL MeshMapCreate( ED%Output(1)%PlatformPtMesh, HD%Input(1)%Morison%LumpedMesh, MeshMapData%ED_P_2_HD_M_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_P_2_HD_M_P' ) + IF ( HD%Input(1)%Morison%LumpedMesh%Committed ) THEN + CALL MeshMapCreate( PlatformMotion, HD%Input(1)%Morison%LumpedMesh, MeshMapData%ED_P_2_HD_M_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Ptfm_2_HD_M_P' ) END IF - ! ElastoDyn point mesh to HydroDyn Morison line mesh (ED sets inputs, but gets outputs from HD%y%AllHdroOrigin in floating case) + ! ElastoDyn point mesh to HydroDyn Morison line mesh (ED sets inputs, but gets outputs from HD%y%AllHdroOrigin in floating case) IF ( HD%Input(1)%Morison%DistribMesh%Committed ) THEN - CALL MeshMapCreate( ED%Output(1)%PlatformPtMesh, HD%Input(1)%Morison%DistribMesh, MeshMapData%ED_P_2_HD_M_L, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_P_2_HD_M_L' ) + CALL MeshMapCreate( PlatformMotion, HD%Input(1)%Morison%DistribMesh, MeshMapData%ED_P_2_HD_M_L, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Ptfm_2_HD_M_L' ) END IF ELSE ! these get mapped to ElastoDyn AND SubDyn (in ED_SD_HD coupling) ! offshore fixed - ! HydroDyn WAMIT mesh to ElastoDyn point mesh + ! HydroDyn WAMIT mesh to ElastoDyn point mesh IF ( HD%y%Mesh%Committed ) THEN - ! HydroDyn WAMIT point mesh to ElastoDyn point mesh ! meshes for fixed-bottom - CALL MeshMapCreate( HD%y%Mesh, ED%Input(1)%PlatformPtMesh, MeshMapData%HD_W_P_2_ED_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':HD_W_P_2_ED_P' ) - CALL MeshMapCreate( ED%Output(1)%PlatformPtMesh, HD%Input(1)%Mesh, MeshMapData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_P_2_HD_W_P' ) + CALL MeshMapCreate( HD%y%Mesh, PlatformLoads, MeshMapData%HD_W_P_2_ED_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':HD_W_P_2_Ptfm' ) + CALL MeshMapCreate( PlatformMotion, HD%Input(1)%Mesh, MeshMapData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Ptfm_2_HD_W_P' ) END IF !------------------------- @@ -4150,10 +4246,10 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M ! NOTE: the MeshMapCreate routine returns fatal errors if either mesh is not committed ! SubDyn transition piece point mesh to/from ElastoDyn point mesh - CALL MeshMapCreate( SD%y%Y1mesh, ED%Input(1)%PlatformPtMesh, MeshMapData%SD_TP_2_ED_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':SD_TP_2_ED_P' ) - CALL MeshMapCreate( ED%Output(1)%PlatformPtMesh, SD%Input(1)%TPMesh, MeshMapData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_P_2_SD_TP' ) + CALL MeshMapCreate( SD%y%Y1mesh, PlatformLoads, MeshMapData%SD_TP_2_ED_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':SD_TP_2_Ptfm' ) + CALL MeshMapCreate( PlatformMotion, SD%Input(1)%TPMesh, MeshMapData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Ptfm_2_SD_TP' ) !------------------------- ! ElastoDyn <-> ExtPtfm @@ -4163,10 +4259,10 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M ! NOTE: the MeshMapCreate routine returns fatal errors if either mesh is not committed ! ExtPtfm PtfmMesh point mesh to/from ElastoDyn point mesh - CALL MeshMapCreate( ExtPtfm%y%PtfmMesh, ED%Input(1)%PlatformPtMesh, MeshMapData%SD_TP_2_ED_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':SD_TP_2_ED_P' ) - CALL MeshMapCreate( ED%Output(1)%PlatformPtMesh, ExtPtfm%Input(1)%PtfmMesh, MeshMapData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_P_2_SD_TP' ) + CALL MeshMapCreate( ExtPtfm%y%PtfmMesh, PlatformLoads, MeshMapData%SD_TP_2_ED_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':SD_TP_2_Ptfm' ) + CALL MeshMapCreate( PlatformMotion, ExtPtfm%Input(1)%PtfmMesh, MeshMapData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Ptfm_2_SD_TP' ) END IF ! SubDyn-ElastoDyn @@ -4177,10 +4273,10 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M !------------------------- ! MAP point mesh to/from ElastoDyn point mesh - CALL MeshMapCreate( MAPp%y%PtFairleadLoad, ED%Input(1)%PlatformPtMesh, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Mooring_P_2_ED_P' ) - CALL MeshMapCreate( ED%Output(1)%PlatformPtMesh, MAPp%Input(1)%PtFairDisplacement, MeshMapData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_P_2_Mooring_P' ) + CALL MeshMapCreate( MAPp%y%PtFairleadLoad, PlatformLoads, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Mooring_P_2_Ptfm' ) + CALL MeshMapCreate( PlatformMotion, MAPp%Input(1)%PtFairDisplacement, MeshMapData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Ptfm_2_Mooring_P' ) ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN !------------------------- @@ -4188,10 +4284,10 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M !------------------------- ! MoorDyn point mesh to/from ElastoDyn point mesh - CALL MeshMapCreate( MD%y%PtFairleadLoad, ED%Input(1)%PlatformPtMesh, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Mooring_P_2_ED_P' ) - CALL MeshMapCreate( ED%Output(1)%PlatformPtMesh, MD%Input(1)%PtFairleadDisplacement, MeshMapData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_P_2_Mooring_P' ) + CALL MeshMapCreate( MD%y%PtFairleadLoad, PlatformLoads, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Mooring_P_2_Ptfm' ) + CALL MeshMapCreate( PlatformMotion, MD%Input(1)%PtFairleadDisplacement, MeshMapData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Ptfm_2_Mooring_P' ) ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN !------------------------- @@ -4199,10 +4295,10 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M !------------------------- ! FEAMooring point mesh to/from ElastoDyn point mesh - CALL MeshMapCreate( FEAM%y%PtFairleadLoad, ED%Input(1)%PlatformPtMesh, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Mooring_P_2_ED_P' ) - CALL MeshMapCreate( ED%Output(1)%PlatformPtMesh, FEAM%Input(1)%PtFairleadDisplacement, MeshMapData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_P_2_Mooring_P' ) + CALL MeshMapCreate( FEAM%y%PtFairleadLoad, PlatformLoads, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Mooring_P_2_Ptfm' ) + CALL MeshMapCreate( PlatformMotion, FEAM%Input(1)%PtFairleadDisplacement, MeshMapData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Ptfm_2_Mooring_P' ) ELSEIF ( p_FAST%CompMooring == Module_Orca ) THEN !------------------------- @@ -4210,10 +4306,10 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M !------------------------- ! OrcaFlex point mesh to/from ElastoDyn point mesh - CALL MeshMapCreate( Orca%y%PtfmMesh, ED%Input(1)%PlatformPtMesh, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Mooring_P_2_ED_P' ) - CALL MeshMapCreate( ED%Output(1)%PlatformPtMesh, Orca%Input(1)%PtfmMesh, MeshMapData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':ED_P_2_Mooring_P' ) + CALL MeshMapCreate( Orca%y%PtfmMesh, PlatformLoads, MeshMapData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Mooring_P_2_Ptfm' ) + CALL MeshMapCreate( PlatformMotion, Orca%Input(1)%PtfmMesh, MeshMapData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':Ptfm_2_Mooring_P' ) END IF ! MAP-ElastoDyn ; FEAM-ElastoDyn; Orca-ElastoDyn @@ -4262,14 +4358,14 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M !............................................................................................................................ ! Initialize the Jacobian structures: !............................................................................................................................ - !IF ( p_FAST%TurbineType == Type_Offshore_Fixed ) THEN ! p_FAST%CompSub == Module_SD .AND. p_FAST%CompHydro == Module_HD + !IF ( p_FAST%TurbineType == Type_Offshore_Fixed ) THEN IF ( p_FAST%CompSub /= Module_None .OR. (p_FAST%CompElast == Module_BD .and. BD_Solve_Option1) .or. p_FAST%CompMooring == Module_Orca) THEN !.OR. p_FAST%CompHydro == Module_HD ) THEN CALL Init_FullOpt1_Jacobian( p_FAST, MeshMapData, ED%Input(1)%PlatformPtMesh, SD%Input(1)%TPMesh, SD%Input(1)%LMesh, & HD%Input(1)%Morison%LumpedMesh, HD%Input(1)%Morison%DistribMesh, HD%Input(1)%Mesh, & ED%Input(1)%HubPtLoad, BD%Input(1,:), Orca%Input(1)%PtfmMesh, ExtPtfm%Input(1)%PtfmMesh, ErrStat2, ErrMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSEIF ( p_FAST%CompHydro == Module_HD ) THEN - CALL AllocAry( MeshMapData%Jacobian_Opt1, SizeJac_ED_HD, SizeJac_ED_HD, 'Jacobian for ED-HD coupling', ErrStat2, ErrMsg2 ) + CALL AllocAry( MeshMapData%Jacobian_Opt1, SizeJac_ED_HD, SizeJac_ED_HD, 'Jacobian for Ptfm-HD coupling', ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF @@ -4286,7 +4382,7 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M CALL ResetRemapFlags(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD ) !............................................................................................................................ - ! initialize the temporary input meshes (for input-output solves): + ! initialize the temporary input meshes (for input-output solves in Solve Option 1): ! (note that we do this after ResetRemapFlags() so that the copies have remap=false) !............................................................................................................................ IF ( p_FAST%CompHydro == Module_HD .OR. p_FAST%CompSub /= Module_None .OR. (p_FAST%CompElast == Module_BD .and. BD_Solve_Option1) & @@ -4307,7 +4403,7 @@ SUBROUTINE InitModuleMappings(p_FAST, ED, BD, AD14, AD, HD, SD, ExtPtfm, SrvD, M ! Temporary meshes for transfering inputs to ED and BD CALL MeshCopy ( ED%Input(1)%HubPtLoad, MeshMapData%u_ED_HubPtLoad_2, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':u_ED_PlatformPtMesh' ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName//':u_ED_HubPtLoad_2' ) allocate( MeshMapData%u_BD_RootMotion( p_FAST%nBeams ), STAT = ErrStat2 ) if (ErrStat2 /= 0) then @@ -4378,8 +4474,9 @@ END SUBROUTINE InitModuleMappings !> This subroutine solves the input-output relations for all of the modules. It is a subroutine because it gets done twice-- !! once at the start of the n_t_global loop and once in the j_pc loop, using different states. !! *** Note that modules that do not have direct feedthrough should be called first. *** -SUBROUTINE CalcOutputs_And_SolveForInputs( n_t_global, this_time, this_state, calcJacobian, NextJacCalcTime, p_FAST, m_FAST, & - ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) +SUBROUTINE CalcOutputs_And_SolveForInputs( n_t_global, this_time, this_state, calcJacobian, NextJacCalcTime, & + p_FAST, m_FAST, WriteThisStep, ED, BD, & + SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) REAL(DbKi) , intent(in ) :: this_time !< The current simulation time (actual or time of prediction) INTEGER(IntKi) , intent(in ) :: this_state !< Index into the state array (current or predicted states) INTEGER(IntKi) , intent(in ) :: n_t_global !< current time step (used only for SrvD hack) @@ -4388,6 +4485,7 @@ SUBROUTINE CalcOutputs_And_SolveForInputs( n_t_global, this_time, this_state, ca TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code TYPE(FAST_MiscVarType), INTENT(IN ) :: m_FAST !< Misc variables (including external inputs) for the glue code + LOGICAL , INTENT(IN ) :: WriteThisStep !< Will we print the WriteOutput values this step? TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data @@ -4453,30 +4551,31 @@ SUBROUTINE CalcOutputs_And_SolveForInputs( n_t_global, this_time, this_state, ca !! !! ## Algorithm: + !> Solve option 2 (modules without direct feedthrough): - CALL SolveOption2(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat2, ErrMsg2, n_t_global < 0) + CALL SolveOption2(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat2, ErrMsg2, n_t_global < 0, WriteThisStep) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - -#ifdef OUTPUT_MASS_MATRIX -if (n_t_global == 0) then - UnMM = -1 - CALL GetNewUnit( UnMM, ErrStat2, ErrMsg2 ) - CALL OpenFOutFile( UnMM, TRIM(p_FAST%OutFileRoot)//'.EDMassMatrix', ErrStat2, ErrMsg2) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF ( ErrStat >= AbortErrLev ) RETURN - CALL WrMatrix(ED%m%AugMat,UnMM, p_FAST%OutFmt) - CLOSE( UnMM ) -end if + +#ifdef OUTPUT_MASS_MATRIX + if (n_t_global == 0) then + UnMM = -1 + CALL GetNewUnit( UnMM, ErrStat2, ErrMsg2 ) + CALL OpenFOutFile( UnMM, TRIM(p_FAST%OutFileRoot)//'.EDMassMatrix', ErrStat2, ErrMsg2) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF ( ErrStat >= AbortErrLev ) RETURN + CALL WrMatrix(ED%m%AugMat,UnMM, p_FAST%OutFmt) + CLOSE( UnMM ) + end if #endif - + !> transfer ED outputs to other modules used in option 1: - CALL Transfer_ED_to_HD_SD_BD_Mooring( p_FAST, ED%Output(1), HD%Input(1), SD%Input(1), ExtPtfm%Input(1), & + CALL Transfer_ED_to_HD_SD_BD_Mooring( p_FAST, ED%y, HD%Input(1), SD%Input(1), ExtPtfm%Input(1), & MAPp%Input(1), FEAM%Input(1), MD%Input(1), & Orca%Input(1), BD%Input(1,:), MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) !> Solve option 1 (rigorous solve on loads/accelerations) - CALL SolveOption1(this_time, this_state, calcJacobian, p_FAST, ED, BD, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2) + CALL SolveOption1(this_time, this_state, calcJacobian, p_FAST, ED, BD, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2, WriteThisStep) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -4484,7 +4583,7 @@ SUBROUTINE CalcOutputs_And_SolveForInputs( n_t_global, this_time, this_state, ca IF ( p_FAST%CompAero == Module_AD14 ) THEN - CALL AD14_InputSolve_NoIfW( p_FAST, AD14%Input(1), ED%Output(1), MeshMapData, ErrStat2, ErrMsg2 ) + CALL AD14_InputSolve_NoIfW( p_FAST, AD14%Input(1), ED%y, MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! because we're not calling InflowWind_CalcOutput or getting new values from OpenFOAM, @@ -4494,7 +4593,7 @@ SUBROUTINE CalcOutputs_And_SolveForInputs( n_t_global, this_time, this_state, ca ELSEIF ( p_FAST%CompAero == Module_AD ) THEN - CALL AD_InputSolve_NoIfW( p_FAST, AD%Input(1), SrvD%y, ED%Output(1), BD, MeshMapData, ErrStat2, ErrMsg2 ) + CALL AD_InputSolve_NoIfW( p_FAST, AD%Input(1), SrvD%y, ED%y, BD, MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! because we're not calling InflowWind_CalcOutput or getting new values from OpenFOAM, @@ -4506,29 +4605,28 @@ SUBROUTINE CalcOutputs_And_SolveForInputs( n_t_global, this_time, this_state, ca END IF IF ( p_FAST%CompInflow == Module_IfW ) THEN - CALL IfW_InputSolve( p_FAST, m_FAST, IfW%Input(1), IfW%p, AD14%Input(1), AD%Input(1), ED%Output(1), ErrStat2, ErrMsg2 ) + CALL IfW_InputSolve( p_FAST, m_FAST, IfW%Input(1), IfW%p, AD14%Input(1), AD%Input(1), ED%y, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSE IF ( p_FAST%CompInflow == Module_OpFM ) THEN ! OpenFOAM is the driver and it sets these inputs outside of this solve; the OpenFOAM inputs and outputs thus don't change ! in this scenario until OpenFOAM takes another step **this is a source of error, but it is the way the OpenFOAM-FAST7 coupling ! works, so I'm not going to spend time that I don't have now to fix it** - CALL OpFM_SetInputs( p_FAST, AD14%p, AD14%Input(1), AD14%y, AD%Input(1), AD%y, ED%Output(1), SrvD%y, OpFM, ErrStat2, ErrMsg2 ) + CALL OpFM_SetInputs( p_FAST, AD14%p, AD14%Input(1), AD14%y, AD%Input(1), AD%y, ED%y, SrvD%y, OpFM, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF IF ( p_FAST%CompServo == Module_SrvD ) THEN - CALL SrvD_InputSolve( p_FAST, m_FAST, SrvD%Input(1), ED%Output(1), IfW%y, OpFM%y, BD%y, MeshmapData, ErrStat2, ErrMsg2, SrvD%y ) ! At initialization, we don't have a previous value, so we'll use the guess inputs instead. note that this violates the framework.... (done for the Bladed DLL) + CALL SrvD_InputSolve( p_FAST, m_FAST, SrvD%Input(1), ED%y, IfW%y, OpFM%y, BD%y, MeshmapData, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF IF (p_FAST%CompElast == Module_BD .and. .NOT. BD_Solve_Option1) THEN ! map ED root and hub motion outputs to BeamDyn: - CALL Transfer_ED_to_BD(ED%Output(1), BD%Input(1,:), MeshMapData, ErrStat2, ErrMsg2 ) + CALL Transfer_ED_to_BD(ED%y, BD%Input(1,:), MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg,RoutineName ) END IF - - + !..................................................................... ! Reset each mesh's RemapFlag (after calling all InputSolve routines): !..................................................................... @@ -4540,7 +4638,7 @@ END SUBROUTINE CalcOutputs_And_SolveForInputs !---------------------------------------------------------------------------------------------------------------------------------- !> This routine implements the "option 1" solve for all inputs with direct links to HD, SD, ExtPtfm, MAP, OrcaFlex interface, and the ED !! platform reference point. Also in solve option 1 are the BD-ED blade root coupling. -SUBROUTINE SolveOption1(this_time, this_state, calcJacobian, p_FAST, ED, BD, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) +SUBROUTINE SolveOption1(this_time, this_state, calcJacobian, p_FAST, ED, BD, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg, WriteThisStep ) !............................................................................................................................... REAL(DbKi) , intent(in ) :: this_time !< The current simulation time (actual or time of prediction) INTEGER(IntKi) , intent(in ) :: this_state !< Index into the state array (current or predicted states) @@ -4567,6 +4665,7 @@ SUBROUTINE SolveOption1(this_time, this_state, calcJacobian, p_FAST, ED, BD, HD, INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + LOGICAL , INTENT(IN ) :: WriteThisStep !< Will we print the WriteOutput values this step? INTEGER :: i ! loop counter @@ -4626,7 +4725,7 @@ SUBROUTINE SolveOption1(this_time, this_state, calcJacobian, p_FAST, ED, BD, HD, IF ( p_FAST%CompSub /= Module_None .OR. (p_FAST%CompElast == Module_BD .and. BD_Solve_Option1) .OR. p_FAST%CompMooring == Module_Orca ) THEN !.OR. p_FAST%CompHydro == Module_HD ) THEN CALL FullOpt1_InputOutputSolve( this_time, p_FAST, calcJacobian & - , ED%Input(1), ED%p, ED%x( this_state), ED%xd( this_state), ED%z( this_state), ED%OtherSt( this_state), ED%Output(1), ED%m & + , ED%Input(1), ED%p, ED%x( this_state), ED%xd( this_state), ED%z( this_state), ED%OtherSt( this_state), ED%y, ED%m & , SD%Input(1), SD%p, SD%x( this_state), SD%xd( this_state), SD%z( this_state), SD%OtherSt( this_state), SD%y , SD%m & , ExtPtfm%Input(1),ExtPtfm%p,ExtPtfm%x( this_state),ExtPtfm%xd( this_state),ExtPtfm%z( this_state),ExtPtfm%OtherSt( this_state),ExtPtfm%y,ExtPtfm%m & , HD%Input(1), HD%p, HD%x( this_state), HD%xd( this_state), HD%z( this_state), HD%OtherSt( this_state), HD%y , HD%m & @@ -4637,17 +4736,17 @@ SUBROUTINE SolveOption1(this_time, this_state, calcJacobian, p_FAST, ED, BD, HD, , MD%Input(1), MD%y & , IceF%Input(1), IceF%y & , IceD%Input(1,:), IceD%y & ! bjj: I don't really want to make temp copies of input types. perhaps we should pass the whole Input() structure? (likewise for BD)... - , MeshMapData , ErrStat2, ErrMsg2 ) + , MeshMapData , ErrStat2, ErrMsg2, WriteThisStep ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSEIF ( p_FAST%CompHydro == Module_HD ) THEN CALL ED_HD_InputOutputSolve( this_time, p_FAST, calcJacobian & - , ED%Input(1), ED%p, ED%x(this_state), ED%xd(this_state), ED%z(this_state), ED%OtherSt(this_state), ED%Output(1), ED%m & - , HD%Input(1), HD%p, HD%x(this_state), HD%xd(this_state), HD%z(this_state), HD%OtherSt(this_state), HD%y, HD%m & + , ED%Input(1), ED%p, ED%x(this_state), ED%xd(this_state), ED%z(this_state), ED%OtherSt(this_state), ED%y, ED%m & + , HD%Input(1), HD%p, HD%x(this_state), HD%xd(this_state), HD%z(this_state), HD%OtherSt(this_state), HD%y, HD%m & , MAPp%Input(1), MAPp%y, FEAM%Input(1), FEAM%y, MD%Input(1), MD%y & - , MeshMapData , ErrStat2, ErrMsg2 ) + , MeshMapData , ErrStat2, ErrMsg2, WriteThisStep ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF ! HD, BD, and/or SD coupled to ElastoDyn @@ -4659,19 +4758,19 @@ SUBROUTINE SolveOption1(this_time, this_state, calcJacobian, p_FAST, ED, BD, HD, IF ( p_FAST%CompMooring == Module_MAP ) THEN ! note: MAP_InputSolve must be called before setting ED loads inputs (so that motions are known for loads [moment] mapping) - CALL MAP_InputSolve( MAPp%Input(1), ED%Output(1), MeshMapData, ErrStat2, ErrMsg2 ) + CALL MAP_InputSolve( MAPp%Input(1), ED%y, MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN ! note: MD_InputSolve must be called before setting ED loads inputs (so that motions are known for loads [moment] mapping) - CALL MD_InputSolve( MD%Input(1), ED%Output(1), MeshMapData, ErrStat2, ErrMsg2 ) + CALL MD_InputSolve( MD%Input(1), ED%y, MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN ! note: FEAM_InputSolve must be called before setting ED loads inputs (so that motions are known for loads [moment] mapping) - CALL FEAM_InputSolve( FEAM%Input(1), ED%Output(1), MeshMapData, ErrStat2, ErrMsg2 ) + CALL FEAM_InputSolve( FEAM%Input(1), ED%y, MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF @@ -4717,7 +4816,7 @@ SUBROUTINE SolveOption1(this_time, this_state, calcJacobian, p_FAST, ED, BD, HD, END SUBROUTINE SolveOption1 !---------------------------------------------------------------------------------------------------------------------------------- !> This routine implements the first part of the "option 2" solve for inputs that apply to BeamDyn and AeroDyn -SUBROUTINE SolveOption2a_Inp2BD(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat, ErrMsg) +SUBROUTINE SolveOption2a_Inp2BD(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat, ErrMsg, WriteThisStep) REAL(DbKi) , intent(in ) :: this_time !< The current simulation time (actual or time of prediction) INTEGER(IntKi) , intent(in ) :: this_state !< Index into the state array (current or predicted states) @@ -4737,8 +4836,8 @@ SUBROUTINE SolveOption2a_Inp2BD(this_time, this_state, p_FAST, m_FAST, ED, BD, A INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + LOGICAL , INTENT(IN ) :: WriteThisStep !< Will we print the WriteOutput values this step? - INTEGER(IntKi) :: k INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMSg2 @@ -4752,12 +4851,12 @@ SUBROUTINE SolveOption2a_Inp2BD(this_time, this_state, p_FAST, m_FAST, ED, BD, A ErrStat = ErrID_None ErrMsg = "" - CALL ED_CalcOutput( this_time, ED%Input(1), ED%p, ED%x(this_state), ED%xd(this_state), ED%z(this_state), ED%OtherSt(this_state), ED%Output(1), ED%m, ErrStat2, ErrMsg2 ) + CALL ED_CalcOutput( this_time, ED%Input(1), ED%p, ED%x(this_state), ED%xd(this_state), ED%z(this_state), ED%OtherSt(this_state), ED%y, ED%m, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF ( p_FAST%CompElast == Module_BD ) THEN ! map ED root and hub motion outputs to BeamDyn: - CALL Transfer_ED_to_BD(ED%Output(1), BD%Input(1,:), MeshMapData, ErrStat2, ErrMsg2 ) + CALL Transfer_ED_to_BD(ED%y, BD%Input(1,:), MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat, ErrMsg,RoutineName ) END IF @@ -4765,7 +4864,7 @@ SUBROUTINE SolveOption2a_Inp2BD(this_time, this_state, p_FAST, m_FAST, ED, BD, A END SUBROUTINE SolveOption2a_Inp2BD !---------------------------------------------------------------------------------------------------------------------------------- !> This routine implements the first part of the "option 2" solve for inputs that apply to AeroDyn & InflowWind -SUBROUTINE SolveOption2b_Inp2IfW(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat, ErrMsg) +SUBROUTINE SolveOption2b_Inp2IfW(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat, ErrMsg, WriteThisStep) REAL(DbKi) , intent(in ) :: this_time !< The current simulation time (actual or time of prediction) INTEGER(IntKi) , intent(in ) :: this_state !< Index into the state array (current or predicted states) @@ -4785,6 +4884,7 @@ SUBROUTINE SolveOption2b_Inp2IfW(this_time, this_state, p_FAST, m_FAST, ED, BD, INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + LOGICAL , INTENT(IN ) :: WriteThisStep !< Will we print the WriteOutput values this step? INTEGER(IntKi) :: k INTEGER(IntKi) :: ErrStat2 @@ -4799,40 +4899,39 @@ SUBROUTINE SolveOption2b_Inp2IfW(this_time, this_state, p_FAST, m_FAST, ED, BD, ErrStat = ErrID_None ErrMsg = "" - + IF ( p_FAST%CompElast == Module_BD .AND. .NOT. BD_Solve_Option1 ) THEN DO k=1,p_FAST%nBeams CALL BD_CalcOutput( this_time, BD%Input(1,k), BD%p(k), BD%x(k,this_state), BD%xd(k,this_state),& - BD%z(k,this_state), BD%OtherSt(k,this_state), BD%y(k), BD%m(k), ErrStat2, ErrMsg2 ) + BD%z(k,this_state), BD%OtherSt(k,this_state), BD%y(k), BD%m(k), ErrStat2, ErrMsg2, .false. ) ! this WriteOutput will get overwritten in solve option 1 CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO END IF - ! find the positions where we want inflow wind in AeroDyn (i.e., set all the motion inputs to AeroDyn) IF ( p_FAST%CompAero == Module_AD14 ) THEN - CALL AD14_InputSolve_NoIfW( p_FAST, AD14%Input(1), ED%Output(1), MeshMapData, ErrStat2, ErrMsg2 ) + CALL AD14_InputSolve_NoIfW( p_FAST, AD14%Input(1), ED%y, MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ELSE IF ( p_FAST%CompAero == Module_AD ) THEN ! note that this uses BD outputs, which are from the previous step (and need to be initialized) - CALL AD_InputSolve_NoIfW( p_FAST, AD%Input(1), SrvD%y, ED%Output(1), BD, MeshMapData, ErrStat2, ErrMsg2 ) + CALL AD_InputSolve_NoIfW( p_FAST, AD%Input(1), SrvD%y, ED%y, BD, MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF IF (p_FAST%CompInflow == Module_IfW) THEN ! must be done after ED_CalcOutput and before AD_CalcOutput and SrvD - CALL IfW_InputSolve( p_FAST, m_FAST, IfW%Input(1), IfW%p, AD14%Input(1), AD%Input(1), ED%Output(1), ErrStat2, ErrMsg2 ) + CALL IfW_InputSolve( p_FAST, m_FAST, IfW%Input(1), IfW%p, AD14%Input(1), AD%Input(1), ED%y, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) !ELSE IF ( p_FAST%CompInflow == Module_OpFM ) THEN ! ! OpenFOAM is the driver and it computes outputs outside of this solve; the OpenFOAM inputs and outputs thus don't change ! ! in this scenario until OpenFOAM takes another step **this is a source of error, but it is the way the OpenFOAM-FAST7 coupling ! ! works, so I'm not going to spend time that I don't have now to fix it** - ! CALL OpFM_SetInputs( p_FAST, AD14%p, AD14%Input(1), AD14%y, AD%Input(1), AD%y, ED%Output(1), SrvD%y, OpFM, ErrStat2, ErrMsg2 ) + ! CALL OpFM_SetInputs( p_FAST, AD14%p, AD14%Input(1), AD14%y, AD%Input(1), AD%y, ED%y, SrvD%y, OpFM, ErrStat2, ErrMsg2 ) ! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF @@ -4840,8 +4939,7 @@ SUBROUTINE SolveOption2b_Inp2IfW(this_time, this_state, p_FAST, m_FAST, ED, BD, END SUBROUTINE SolveOption2b_Inp2IfW !---------------------------------------------------------------------------------------------------------------------------------- !> This routine implements the first part of the "option 2" solve for inputs that apply to AeroDyn and ServoDyn. -SUBROUTINE SolveOption2c_Inp2AD_SrvD(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat, ErrMsg, firstCall) - LOGICAL , intent(in ) :: firstCall !< flag to determine how to call ServoDyn (a hack) +SUBROUTINE SolveOption2c_Inp2AD_SrvD(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat, ErrMsg, WriteThisStep) REAL(DbKi) , intent(in ) :: this_time !< The current simulation time (actual or time of prediction) INTEGER(IntKi) , intent(in ) :: this_state !< Index into the state array (current or predicted states) @@ -4861,8 +4959,8 @@ SUBROUTINE SolveOption2c_Inp2AD_SrvD(this_time, this_state, p_FAST, m_FAST, ED, INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + LOGICAL , INTENT(IN ) :: WriteThisStep !< Will we print the WriteOutput values this step? - INTEGER(IntKi) :: k INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMSg2 @@ -4886,6 +4984,8 @@ SUBROUTINE SolveOption2c_Inp2AD_SrvD(this_time, this_state, p_FAST, m_FAST, ED, ! ! OpenFOAM is the driver and it computes outputs outside of this solve; the OpenFOAM inputs and outputs thus don't change ! ! in this scenario until OpenFOAM takes another step **this is a source of error, but it is the way the OpenFOAM-FAST7 coupling ! ! works, so I'm not going to spend time that I don't have now to fix it** + ! CALL OpFM_SetInputs( p_FAST, AD14%p, AD14%Input(1), AD14%y, AD%Input(1), AD%y, ED%y, SrvD%y, OpFM, ErrStat2, ErrMsg2 ) + ! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! CALL OpFM_SetWriteOutput(OpFM) END IF @@ -4905,15 +5005,8 @@ SUBROUTINE SolveOption2c_Inp2AD_SrvD(this_time, this_state, p_FAST, m_FAST, ED, IF ( p_FAST%CompServo == Module_SrvD ) THEN - !!!CALL SrvD_InputSolve( p_FAST, m_FAST, SrvD%Input(1), ED%Output(1), IfW%y, OpFM%y, BD%y, MeshMapData, ErrStat2, ErrMsg2 ) - !!! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! note that the inputs at step(n) for ServoDyn include the outputs from step(n-1) - IF ( firstCall ) THEN - CALL SrvD_InputSolve( p_FAST, m_FAST, SrvD%Input(1), ED%Output(1), IfW%y, OpFM%y, BD%y, MeshMapData, ErrStat2, ErrMsg2 ) ! At initialization, we don't have a previous value, so we'll use the guess inputs instead. note that this violates the framework.... (done for the Bladed DLL) - ELSE - CALL SrvD_InputSolve( p_FAST, m_FAST, SrvD%Input(1), ED%Output(1), IfW%y, OpFM%y, BD%y, MeshMapData, ErrStat2, ErrMsg2, SrvD%y ) ! note that this uses the outputs from the previous step, violating the framework for the Bladed DLL (if SrvD%y is used in another way, this will need to be changed) - END IF - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SrvD_InputSolve( p_FAST, m_FAST, SrvD%Input(1), ED%y, IfW%y, OpFM%y, BD%y, MeshMapData, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF @@ -4921,7 +5014,7 @@ END SUBROUTINE SolveOption2c_Inp2AD_SrvD !---------------------------------------------------------------------------------------------------------------------------------- !> This routine implements the "option 2" solve for all inputs without direct links to HD, SD, MAP, or the ED platform reference !! point. -SUBROUTINE SolveOption2(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat, ErrMsg, firstCall) +SUBROUTINE SolveOption2(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat, ErrMsg, firstCall, WriteThisStep) !............................................................................................................................... LOGICAL , intent(in ) :: firstCall !< flag to determine how to call ServoDyn (a hack) REAL(DbKi) , intent(in ) :: this_time !< The current simulation time (actual or time of prediction) @@ -4943,13 +5036,12 @@ SUBROUTINE SolveOption2(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - + LOGICAL , INTENT(IN ) :: WriteThisStep !< Will we print the WriteOutput values this step? - INTEGER(IntKi) :: k INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMSg2 - CHARACTER(*), PARAMETER :: RoutineName = 'SolveOption2' + CHARACTER(*), PARAMETER :: RoutineName = 'SolveOption2' !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !> ++ Option 2: Solve for inputs based only on the current outputs. @@ -4963,18 +5055,17 @@ SUBROUTINE SolveOption2(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, ! SolveOption2* routines are being called in FAST_AdvanceStates, but the first time we call CalcOutputs_And_SolveForInputs, we haven't called the AdvanceStates routine IF (firstCall) THEN ! call ElastoDyn's CalcOutput & compute BD inputs from ED: - CALL SolveOption2a_Inp2BD(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat2, ErrMsg2) + CALL SolveOption2a_Inp2BD(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat2, ErrMsg2, WriteThisStep) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! compute AD position inputs; compute all of IfW inputs from ED/BD outputs: - CALL SolveOption2b_Inp2IfW(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat2, ErrMsg2) + CALL SolveOption2b_Inp2IfW(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat2, ErrMsg2, WriteThisStep) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! call IfW's CalcOutput; transfer wind-inflow inputs to AD; compute all of SrvD inputs: - CALL SolveOption2c_Inp2AD_SrvD(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat2, ErrMsg2, firstCall) + CALL SolveOption2c_Inp2AD_SrvD(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat2, ErrMsg2, WriteThisStep) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! ELSE ! these subroutines are called in the AdvanceStates routine before BD, IfW, AD, and SrvD states are updated. This gives a more accurate solution that would otherwise require a correction step. END IF - - + IF ( p_FAST%CompAero == Module_AD14 ) THEN CALL AD14_CalcOutput( this_time, AD14%Input(1), AD14%p, AD14%x(this_state), AD14%xd(this_state), AD14%z(this_state), & @@ -4984,13 +5075,13 @@ SUBROUTINE SolveOption2(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, ELSE IF ( p_FAST%CompAero == Module_AD ) THEN CALL AD_CalcOutput( this_time, AD%Input(1), AD%p, AD%x(this_state), AD%xd(this_state), AD%z(this_state), & - AD%OtherSt(this_state), AD%y, AD%m, ErrStat2, ErrMsg2 ) + AD%OtherSt(this_state), AD%y, AD%m, ErrStat2, ErrMsg2, WriteThisStep ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF - + IF ( p_FAST%CompServo == Module_SrvD ) THEN - + CALL SrvD_CalcOutput( this_time, SrvD%Input(1), SrvD%p, SrvD%x(this_state), SrvD%xd(this_state), SrvD%z(this_state), & SrvD%OtherSt(this_state), SrvD%y, SrvD%m, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -5002,7 +5093,7 @@ SUBROUTINE SolveOption2(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, ! in this scenario until OpenFOAM takes another step **this is a source of error, but it is the way the OpenFOAM-FAST7 coupling ! works, so I'm not going to spend time that I don't have now to fix it** ! note that I'm setting these inputs AFTER the call to ServoDyn so OpenFOAM gets all the inputs updated at the same step - CALL OpFM_SetInputs( p_FAST, AD14%p, AD14%Input(1), AD14%y, AD%Input(1), AD%y, ED%Output(1), SrvD%y, OpFM, ErrStat2, ErrMsg2 ) + CALL OpFM_SetInputs( p_FAST, AD14%p, AD14%Input(1), AD14%y, AD%Input(1), AD%y, ED%y, SrvD%y, OpFM, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) CALL OpFM_SetWriteOutput(OpFM) @@ -5010,23 +5101,21 @@ SUBROUTINE SolveOption2(this_time, this_state, p_FAST, m_FAST, ED, BD, AD14, AD, !bjj: note ED%Input(1) may be a sibling mesh of output, but ED%u is not (routine may update something that needs to be shared between siblings) - CALL ED_InputSolve( p_FAST, ED%Input(1), ED%Output(1), AD14%p, AD14%y, AD%y, SrvD%y, AD%Input(1), SrvD%Input(1), MeshMapData, ErrStat2, ErrMsg2 ) + CALL ED_InputSolve( p_FAST, ED%Input(1), ED%y, AD14%p, AD14%y, AD%y, SrvD%y, AD%Input(1), SrvD%Input(1), MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL BD_InputSolve( p_FAST, BD, AD%y, AD%Input(1), MeshMapData, ErrStat2, ErrMsg2 ) + CALL BD_InputSolve( p_FAST, BD, AD%y, AD%Input(1), ED%y, MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - END SUBROUTINE SolveOption2 !---------------------------------------------------------------------------------------------------------------------------------- !> This routines advances the states of each module -SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, & - MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg ) +SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, & + MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg, WriteThisStep ) REAL(DbKi), INTENT(IN ) :: t_initial !< initial simulation time (almost always 0) INTEGER(IntKi), INTENT(IN ) :: n_t_global !< integer time step TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code - TYPE(FAST_OutputFileType),INTENT(IN ) :: y_FAST !< Output variables for the glue code TYPE(FAST_MiscVarType), INTENT(IN ) :: m_FAST !< Miscellaneous variables TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data @@ -5050,6 +5139,7 @@ SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + LOGICAL , INTENT(IN ) :: WriteThisStep !< Will we print the WriteOutput values this step (for optimizations with SolveOption2)? ! local variables INTEGER(IntKi) :: i, k ! loop counters @@ -5057,7 +5147,7 @@ SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED REAL(DbKi) :: t_module ! Current simulation time for module REAL(DbKi) :: t_global_next ! Simulation time for computing outputs INTEGER(IntKi) :: j_ss ! substep loop counter - INTEGER(IntKi) :: n_t_module ! simulation time step, loop counter for individual modules + INTEGER(IntKi) :: n_t_module ! simulation time step, loop counter for individual modules INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FAST_AdvanceStates' @@ -5091,12 +5181,13 @@ SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED CALL ED_UpdateStates( t_module, n_t_module, ED%Input, ED%InputTimes, ED%p, ED%x(STATE_PRED), ED%xd(STATE_PRED), & ED%z(STATE_PRED), ED%OtherSt(STATE_PRED), ED%m, ErrStat2, ErrMsg2 ) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - + IF (ErrStat >= AbortErrLev) RETURN END DO !j_ss + - ! BeamDyn doesn't like extrapolated rotations, so we will calculate them from ED and transfer instead of doing a correction step. - ! AD15/DBEMT also doesn't like extrapolated motions, so we will calculate them from ED/BD instead of doing a correction step. - CALL SolveOption2a_Inp2BD(t_global_next, STATE_PRED, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat2, ErrMsg2) + ! BeamDyn doesn't like extrapolated rotations, so we will calculate them from ED and transfer instead of doing a correction step. + ! (Also calls ED_CalcOutput here so that we can use it for AeroDyn optimization, too): + CALL SolveOption2a_Inp2BD(t_global_next, STATE_PRED, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat2, ErrMsg2, WriteThisStep) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF ( p_FAST%CompElast == Module_BD ) THEN @@ -5122,12 +5213,13 @@ SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED END DO !j_ss END DO !nBeams + IF (ErrStat >= AbortErrLev) RETURN END IF !CompElast - + ! because AeroDyn DBEMT states depend heavily on getting inputs correct, we are overwriting its inputs with updated structural outputs here - CALL SolveOption2b_Inp2IfW(t_global_next, STATE_PRED, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat2, ErrMsg2) + CALL SolveOption2b_Inp2IfW(t_global_next, STATE_PRED, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat2, ErrMsg2, WriteThisStep) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -5154,7 +5246,7 @@ SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED ! because AeroDyn DBEMT states depend heavily on getting inputs correct, we are overwriting its inputs with updated inflow outputs here - CALL SolveOption2c_Inp2AD_SrvD(t_global_next, STATE_PRED, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat2, ErrMsg2, .false.) + CALL SolveOption2c_Inp2AD_SrvD(t_global_next, STATE_PRED, p_FAST, m_FAST, ED, BD, AD14, AD, SrvD, IfW, OpFM, MeshMapData, ErrStat2, ErrMsg2, WriteThisStep) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! AeroDyn: get predicted states @@ -5196,7 +5288,7 @@ SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED END DO !j_ss END IF - + ! ServoDyn: get predicted states IF ( p_FAST%CompServo == Module_SrvD ) THEN CALL SrvD_CopyContState (SrvD%x( STATE_CURR), SrvD%x( STATE_PRED), MESH_UPDATECOPY, Errstat2, ErrMsg2) @@ -5215,6 +5307,7 @@ SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED CALL SrvD_UpdateStates( t_module, n_t_module, SrvD%Input, SrvD%InputTimes, SrvD%p, SrvD%x(STATE_PRED), SrvD%xd(STATE_PRED), & SrvD%z(STATE_PRED), SrvD%OtherSt(STATE_PRED), SrvD%m, ErrStat2, ErrMsg2 ) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if (ErrStat >= AbortErrLev) return END DO !j_ss END IF @@ -5411,12 +5504,11 @@ SUBROUTINE FAST_AdvanceStates( t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED END SUBROUTINE FAST_AdvanceStates !---------------------------------------------------------------------------------------------------------------------------------- !> This routine extrapolates inputs to modules to give predicted values at t+dt. -SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & +SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & IceF, IceD, ErrStat, ErrMsg ) REAL(DbKi), INTENT(IN ) :: t_global_next !< next global time step (t + dt), at which we're extrapolating inputs (and ED outputs) TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code - TYPE(FAST_OutputFileType),INTENT(IN ) :: y_FAST !< Output variables for the glue code TYPE(FAST_MiscVarType), INTENT(IN ) :: m_FAST !< Miscellaneous variables TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data @@ -5450,9 +5542,9 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, y_FAST, m_FAST, ED, BD, !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ! Step 1.a: Extrapolate Inputs (gives predicted values at t+dt) ! - ! a) Extrapolate inputs (and outputs -- bjj: output extrapolation not necessary, yet) + ! a) Extrapolate inputs ! to t + dt (i.e., t_global_next); will only be used by modules with an implicit dependence on input data. - ! b) Shift "window" of the ModName_Input and ModName_Output + ! b) Shift "window" of the ModName%Input !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ErrStat = ErrID_None @@ -5462,23 +5554,15 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, y_FAST, m_FAST, ED, BD, CALL ED_Input_ExtrapInterp(ED%Input, ED%InputTimes, ED%u, t_global_next, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - CALL ED_Output_ExtrapInterp(ED%Output, ED%InputTimes, ED%y, t_global_next, ErrStat2, ErrMsg2) !this extrapolated value is used in the ED-HD coupling - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - - DO j = p_FAST%InterpOrder, 1, -1 CALL ED_CopyInput (ED%Input(j), ED%Input(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - CALL ED_CopyOutput(ED%Output(j), ED%Output(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) ED%InputTimes(j+1) = ED%InputTimes(j) !ED_OutputTimes(j+1) = ED_OutputTimes(j) END DO CALL ED_CopyInput (ED%u, ED%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - CALL ED_CopyOutput (ED%y, ED%Output(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) ED%InputTimes(1) = t_global_next !ED_OutputTimes(1) = t_global_next @@ -5505,8 +5589,7 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, y_FAST, m_FAST, ED, BD, END DO ! k=p_FAST%nBeams - END IF ! BeamDyn - + END IF ! BeamDyn ! AeroDyn v14 IF ( p_FAST%CompAero == Module_AD14 ) THEN @@ -5514,11 +5597,7 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, y_FAST, m_FAST, ED, BD, CALL AD14_Input_ExtrapInterp(AD14%Input, AD14%InputTimes, AD14%u, t_global_next, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL AD14_Output_ExtrapInterp(AD14_Output, AD14_OutputTimes, AD14%y, t_global_next, ErrStat2, ErrMsg2) - ! CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - - - ! Shift "window" of AD14%Input and AD14_Output + ! Shift "window" of AD14%Input DO j = p_FAST%InterpOrder, 1, -1 CALL AD14_CopyInput (AD14%Input(j), AD14%Input(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) @@ -5556,25 +5635,17 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, y_FAST, m_FAST, ED, BD, CALL InflowWind_Input_ExtrapInterp(IfW%Input, IfW%InputTimes, IfW%u, t_global_next, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL InflowWind_Output_ExtrapInterp(IfW_Output, IfW_OutputTimes, IfW%y, t_global_next, ErrStat2, ErrMsg2) - ! CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - - - ! Shift "window" of IfW%Input and IfW_Output + ! Shift "window" of IfW%Input DO j = p_FAST%InterpOrder, 1, -1 CALL InflowWind_CopyInput (IfW%Input(j), IfW%Input(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL InflowWind_CopyOutput(IfW_Output(j), IfW_Output(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) IfW%InputTimes(j+1) = IfW%InputTimes(j) - !IfW_OutputTimes(j+1) = IfW_OutputTimes(j) END DO CALL InflowWind_CopyInput (IfW%u, IfW%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL InflowWind_CopyOutput(IfW%y, IfW_Output(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) IfW%InputTimes(1) = t_global_next - !IfW_OutputTimes(1) = t_global_next END IF ! CompInflow @@ -5584,26 +5655,18 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, y_FAST, m_FAST, ED, BD, CALL SrvD_Input_ExtrapInterp(SrvD%Input, SrvD%InputTimes, SrvD%u, t_global_next, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - - !CALL SrvD_Output_ExtrapInterp(SrvD_Output, SrvD_OutputTimes, SrvD%y, t_global_next, ErrStat2, ErrMsg2) - ! CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - - ! Shift "window" of SrvD%Input and SrvD_Output + ! Shift "window" of SrvD%Input DO j = p_FAST%InterpOrder, 1, -1 CALL SrvD_CopyInput (SrvD%Input(j), SrvD%Input(j+1), MESH_UPDATECOPY, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL SrvD_CopyOutput(SrvD_Output(j), SrvD_Output(j+1), MESH_UPDATECOPY, ErrStat2, ErrMsg2) SrvD%InputTimes(j+1) = SrvD%InputTimes(j) - !SrvD_OutputTimes(j+1) = SrvD_OutputTimes(j) END DO CALL SrvD_CopyInput (SrvD%u, SrvD%Input(1), MESH_UPDATECOPY, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL SrvD_CopyOutput(SrvD%y, SrvD_Output(1), MESH_UPDATECOPY, ErrStat2, ErrMsg2) SrvD%InputTimes(1) = t_global_next - !SrvD_OutputTimes(1) = t_global_next END IF ! ServoDyn @@ -5613,25 +5676,18 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, y_FAST, m_FAST, ED, BD, CALL HydroDyn_Input_ExtrapInterp(HD%Input, HD%InputTimes, HD%u, t_global_next, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL HydroDyn_Output_ExtrapInterp(HD_Output, HD_OutputTimes, HD%y, t_global_next, ErrStat2, ErrMsg2) - ! CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - - ! Shift "window" of HD%Input and HD_Output + ! Shift "window" of HD%Input DO j = p_FAST%InterpOrder, 1, -1 CALL HydroDyn_CopyInput (HD%Input(j), HD%Input(j+1), MESH_UPDATECOPY, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL HydroDyn_CopyOutput(HD_Output(j), HD_Output(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) HD%InputTimes(j+1) = HD%InputTimes(j) - !HD_OutputTimes(j+1)= HD_OutputTimes(j) END DO CALL HydroDyn_CopyInput (HD%u, HD%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL HydroDyn_CopyOutput(HD%y, HD_Output(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) HD%InputTimes(1) = t_global_next - !HD_OutputTimes(1) = t_global_next END IF ! HydroDyn @@ -5641,55 +5697,38 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, y_FAST, m_FAST, ED, BD, CALL SD_Input_ExtrapInterp(SD%Input, SD%InputTimes, SD%u, t_global_next, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - - !CALL SD_Output_ExtrapInterp(SD_Output, SD_OutputTimes, SD%y, t_global_next, ErrStat2, ErrMsg2) - ! CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - - ! Shift "window" of SD%Input and SD_Output + ! Shift "window" of SD%Input DO j = p_FAST%InterpOrder, 1, -1 CALL SD_CopyInput (SD%Input(j), SD%Input(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL SD_CopyOutput(SD_Output(j), SD_Output(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) SD%InputTimes(j+1) = SD%InputTimes(j) - !SD_OutputTimes(j+1) = SD_OutputTimes(j) END DO CALL SD_CopyInput (SD%u, SD%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL SD_CopyOutput(SD%y, SD_Output(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) SD%InputTimes(1) = t_global_next - !SD_OutputTimes(1) = t_global_next ELSE IF ( p_FAST%CompSub == Module_ExtPtfm ) THEN CALL ExtPtfm_Input_ExtrapInterp(ExtPtfm%Input, ExtPtfm%InputTimes, ExtPtfm%u, t_global_next, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL ExtPtfm_Output_ExtrapInterp(ExtPtfm_Output, ExtPtfm_OutputTimes, ExtPtfm%y, t_global_next, ErrStat2, ErrMsg2) - ! CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - - - ! Shift "window" of ExtPtfm%Input and ExtPtfm_Output + ! Shift "window" of ExtPtfm%Input DO j = p_FAST%InterpOrder, 1, -1 CALL ExtPtfm_CopyInput (ExtPtfm%Input(j), ExtPtfm%Input(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL ExtPtfm_CopyOutput(ExtPtfm_Output(j), ExtPtfm_Output(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) ExtPtfm%InputTimes(j+1) = ExtPtfm%InputTimes(j) - !ExtPtfm_OutputTimes(j+1) = ExtPtfm_OutputTimes(j) END DO CALL ExtPtfm_CopyInput (ExtPtfm%u, ExtPtfm%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL ExtPtfm_CopyOutput(ExtPtfm%y, ExtPtfm_Output(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) ExtPtfm%InputTimes(1) = t_global_next - !ExtPtfm_OutputTimes(1) = t_global_next END IF ! SubDyn/ExtPtfm_MCKF - ! Mooring (MAP , FEAM , MoorDyn) ! MAP IF ( p_FAST%CompMooring == Module_MAP ) THEN @@ -5697,25 +5736,17 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, y_FAST, m_FAST, ED, BD, CALL MAP_Input_ExtrapInterp(MAPp%Input, MAPp%InputTimes, MAPp%u, t_global_next, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL MAP_Output_ExtrapInterp(MAP_Output, MAP_OutputTimes, MAPp%y, t_global_next, ErrStat2, ErrMsg2) - ! CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - - - ! Shift "window" of MAPp%Input and MAP_Output + ! Shift "window" of MAPp%Input DO j = p_FAST%InterpOrder, 1, -1 CALL MAP_CopyInput (MAPp%Input(j), MAPp%Input(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL MAP_CopyOutput(MAP_Output(j), MAP_Output(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) MAPp%InputTimes(j+1) = MAPp%InputTimes(j) - !MAP_OutputTimes(j+1) = MAP_OutputTimes(j) END DO CALL MAP_CopyInput (MAPp%u, MAPp%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL MAP_CopyOutput(MAPp%y, MAP_Output(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) MAPp%InputTimes(1) = t_global_next - !MAP_OutputTimes(1) = t_global_next ! MoorDyn ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN @@ -5723,25 +5754,17 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, y_FAST, m_FAST, ED, BD, CALL MD_Input_ExtrapInterp(MD%Input, MD%InputTimes, MD%u, t_global_next, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL MD_Output_ExtrapInterp(MD_Output, MD_OutputTimes, MD%y, t_global_next, ErrStat2, ErrMsg2) - ! CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - - - ! Shift "window" of MD%Input and MD_Output + ! Shift "window" of MD%Input DO j = p_FAST%InterpOrder, 1, -1 CALL MD_CopyInput (MD%Input(j), MD%Input(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL MD_CopyOutput(MD_Output(j), MD_Output(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) MD%InputTimes( j+1) = MD%InputTimes( j) - !MD_OutputTimes(j+1) = MD_OutputTimes(j) END DO CALL MD_CopyInput (MD%u, MD%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL MD_CopyOutput(MD%y, MD_Output(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) MD%InputTimes(1) = t_global_next - !MD_OutputTimes(1) = t_global_next ! FEAM ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN @@ -5749,25 +5772,17 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, y_FAST, m_FAST, ED, BD, CALL FEAM_Input_ExtrapInterp(FEAM%Input, FEAM%InputTimes, FEAM%u, t_global_next, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL FEAM_Output_ExtrapInterp(FEAM_Output, FEAM_OutputTimes, FEAM%y, t_global_next, ErrStat2, ErrMsg2) - ! CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - - - ! Shift "window" of FEAM%Input and FEAM_Output + ! Shift "window" of FEAM%Input DO j = p_FAST%InterpOrder, 1, -1 CALL FEAM_CopyInput (FEAM%Input(j), FEAM%Input(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL FEAM_CopyOutput(FEAM_Output(j), FEAM_Output(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) FEAM%InputTimes( j+1) = FEAM%InputTimes( j) - !FEAM_OutputTimes(j+1) = FEAM_OutputTimes(j) END DO CALL FEAM_CopyInput (FEAM%u, FEAM%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL FEAM_CopyOutput(FEAM%y, FEAM_Output(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) FEAM%InputTimes(1) = t_global_next - !FEAM_OutputTimes(1) = t_global_next ! OrcaFlex ELSEIF ( p_FAST%CompMooring == Module_Orca ) THEN @@ -5797,26 +5812,18 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, y_FAST, m_FAST, ED, BD, CALL IceFloe_Input_ExtrapInterp(IceF%Input, IceF%InputTimes, IceF%u, t_global_next, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - - !CALL IceFloe_Output_ExtrapInterp(IceF_Output, IceF_OutputTimes, IceF%y, t_global_next, ErrStat2, ErrMsg2) - ! CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - - ! Shift "window" of IceF%Input and IceF_Output + ! Shift "window" of IceF%Input DO j = p_FAST%InterpOrder, 1, -1 CALL IceFloe_CopyInput (IceF%Input(j), IceF%Input(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL IceFloe_CopyOutput(IceF_Output(j), IceF_Output(j+1), MESH_UPDATECOPY, Errstat2, ErrMsg2) IceF%InputTimes(j+1) = IceF%InputTimes(j) - !IceF_OutputTimes(j+1) = IceF_OutputTimes(j) END DO CALL IceFloe_CopyInput (IceF%u, IceF%Input(1), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL IceFloe_CopyOutput(IceF%y, IceF_Output(1), MESH_UPDATECOPY, Errstat, ErrMsg) IceF%InputTimes(1) = t_global_next - !IceF_OutputTimes(1) = t_global_next ! IceDyn ELSEIF ( p_FAST%CompIce == Module_IceD ) THEN @@ -5825,26 +5832,18 @@ SUBROUTINE FAST_ExtrapInterpMods( t_global_next, p_FAST, y_FAST, m_FAST, ED, BD, CALL IceD_Input_ExtrapInterp(IceD%Input(:,i), IceD%InputTimes(:,i), IceD%u(i), t_global_next, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - - !CALL IceD_Output_ExtrapInterp(IceD%Output(:,i), IceD%OutputTimes(:,i), IceD%y(i), t_global_next, ErrStat2, ErrMsg2) - ! CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - - ! Shift "window" of IceD%Input and IceD%Output + ! Shift "window" of IceD%Input DO j = p_FAST%InterpOrder, 1, -1 CALL IceD_CopyInput (IceD%Input(j,i), IceD%Input(j+1,i), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL IceD_CopyOutput(IceD%Output(j,i), IceD%Output(j+1,i), MESH_UPDATECOPY, Errstat2, ErrMsg2) IceD%InputTimes(j+1,i) = IceD%InputTimes(j,i) - !IceD%OutputTimes(j+1,i) = IceD%OutputTimes(j,i) END DO CALL IceD_CopyInput (IceD%u(i), IceD%Input(1,i), MESH_UPDATECOPY, Errstat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName ) - !CALL IceD_CopyOutput(IceD%y(i), IceD%Output(1,i), MESH_UPDATECOPY, Errstat2, ErrMsg2) IceD%InputTimes(1,i) = t_global_next - !IceD%OutputTimes(1,i) = t_global_next END DO ! numIceLegs diff --git a/modules/openfast-library/src/FAST_Subs.f90 b/modules/openfast-library/src/FAST_Subs.f90 index 6876cca9a3..2cca60d7fc 100644 --- a/modules/openfast-library/src/FAST_Subs.f90 +++ b/modules/openfast-library/src/FAST_Subs.f90 @@ -106,57 +106,8 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! local variables CHARACTER(1024) :: InputFile !< A CHARACTER string containing the name of the primary FAST input file + TYPE(FAST_InitData) :: Init !< Initialization data for all modules - TYPE(ED_InitInputType) :: InitInData_ED ! Initialization input data - TYPE(ED_InitOutputType) :: InitOutData_ED ! Initialization output data - - TYPE(BD_InitInputType) :: InitInData_BD ! Initialization input data - TYPE(BD_InitOutputType), ALLOCATABLE :: InitOutData_BD(:) ! Initialization output data - - TYPE(SrvD_InitInputType) :: InitInData_SrvD ! Initialization input data - TYPE(SrvD_InitOutputType) :: InitOutData_SrvD ! Initialization output data - - TYPE(AD14_InitInputType) :: InitInData_AD14 ! Initialization input data - TYPE(AD14_InitOutputType) :: InitOutData_AD14 ! Initialization output data - - TYPE(AD_InitInputType) :: InitInData_AD ! Initialization input data - TYPE(AD_InitOutputType) :: InitOutData_AD ! Initialization output data - - TYPE(InflowWind_InitInputType) :: InitInData_IfW ! Initialization input data - TYPE(InflowWind_InitOutputType) :: InitOutData_IfW ! Initialization output data - - TYPE(OpFM_InitInputType) :: InitInData_OpFM ! Initialization input data - TYPE(OpFM_InitOutputType) :: InitOutData_OpFM ! Initialization output data - - TYPE(SC_InitInputType) :: InitInData_SC ! Initialization input data - TYPE(SC_InitOutputType) :: InitOutData_SC ! Initialization output data - - TYPE(HydroDyn_InitInputType) :: InitInData_HD ! Initialization input data - TYPE(HydroDyn_InitOutputType) :: InitOutData_HD ! Initialization output data - - TYPE(SD_InitInputType) :: InitInData_SD ! Initialization input data - TYPE(SD_InitOutputType) :: InitOutData_SD ! Initialization output data - - TYPE(ExtPtfm_InitInputType) :: InitInData_ExtPtfm ! Initialization input data - TYPE(ExtPtfm_InitOutputType) :: InitOutData_ExtPtfm ! Initialization output data - - TYPE(MAP_InitInputType) :: InitInData_MAP ! Initialization input data - TYPE(MAP_InitOutputType) :: InitOutData_MAP ! Initialization output data - - TYPE(FEAM_InitInputType) :: InitInData_FEAM ! Initialization input data - TYPE(FEAM_InitOutputType) :: InitOutData_FEAM ! Initialization output data - - TYPE(MD_InitInputType) :: InitInData_MD ! Initialization input data - TYPE(MD_InitOutputType) :: InitOutData_MD ! Initialization output data - - TYPE(Orca_InitInputType) :: InitInData_Orca ! Initialization input data - TYPE(Orca_InitOutputType) :: InitOutData_Orca ! Initialization output data - - TYPE(IceFloe_InitInputType) :: InitInData_IceF ! Initialization input data - TYPE(IceFloe_InitOutputType) :: InitOutData_IceF ! Initialization output data - - TYPE(IceD_InitInputType) :: InitInData_IceD ! Initialization input data - TYPE(IceD_InitOutputType) :: InitOutData_IceD ! Initialization output data (each instance will have the same output channels) REAL(ReKi) :: AirDens ! air density for initialization/normalization of OpenFOAM data REAL(DbKi) :: dt_IceD ! tmp dt variable to ensure IceDyn doesn't specify different dt values for different legs (IceDyn instances) @@ -181,6 +132,8 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, y_FAST%UnGra = -1 ! set the binary graphics output file unit to -1 to indicate it's not open p_FAST%WrVTK = VTK_Unknown ! set this so that we can potentially output VTK information on initialization error + p_FAST%VTK_tWidth = 1 ! initialize in case of error before reading the full file + p_FAST%n_VTKTime = 1 ! initialize in case of error before reading the full file y_FAST%VTK_LastWaveIndx = 1 ! Start looking for wave data at the first index y_FAST%VTK_count = 0 ! first VTK file has 0 as output y_FAST%n_Out = 0 ! set the number of ouptut channels to 0 to indicate there's nothing to write to the binary file @@ -196,7 +149,10 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, m_FAST%calcJacobian = .TRUE. ! we need to calculate the Jacobian m_FAST%NextJacCalcTime = m_FAST%t_global ! We want to calculate the Jacobian on the first step p_FAST%TDesc = '' +! p_FAST%CheckHSSBrTrqC = .false. + y_FAST%Lin%WindSpeed = 0.0_ReKi + if (present(ExternInitData)) then CallStart = .not. ExternInitData%FarmIntegration ! .and. ExternInitData%TurbineID == 1 if (ExternInitData%TurbineID > 0) p_FAST%TDesc = 'T'//trim(num2lstr(ExternInitData%TurbineID)) @@ -234,14 +190,14 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, p_FAST%TurbinePos = ExternInitData%TurbinePos if (ExternInitData%FarmIntegration) then ! we're integrating with FAST.Farm - CALL FAST_Init( p_FAST, y_FAST, t_initial, InputFile, ErrStat2, ErrMsg2, ExternInitData%TMax, OverrideAbortLev=.false., RootName=ExternInitData%RootName ) + CALL FAST_Init( p_FAST, m_FAST, y_FAST, t_initial, InputFile, ErrStat2, ErrMsg2, ExternInitData%TMax, OverrideAbortLev=.false., RootName=ExternInitData%RootName ) else - CALL FAST_Init( p_FAST, y_FAST, t_initial, InputFile, ErrStat2, ErrMsg2, ExternInitData%TMax, ExternInitData%TurbineID ) ! We have the name of the input file and the simulation length from somewhere else (e.g. Simulink) + CALL FAST_Init( p_FAST, m_FAST, y_FAST, t_initial, InputFile, ErrStat2, ErrMsg2, ExternInitData%TMax, ExternInitData%TurbineID ) ! We have the name of the input file and the simulation length from somewhere else (e.g. Simulink) end if else p_FAST%TurbinePos = 0.0_ReKi - CALL FAST_Init( p_FAST, y_FAST, t_initial, InputFile, ErrStat2, ErrMsg2 ) ! We have the name of the input file from somewhere else (e.g. Simulink) + CALL FAST_Init( p_FAST, m_FAST, y_FAST, t_initial, InputFile, ErrStat2, ErrMsg2 ) ! We have the name of the input file from somewhere else (e.g. Simulink) end if CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -259,26 +215,26 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! initialize ElastoDyn (must be done first) ! ........................ - ALLOCATE( ED%Input( p_FAST%InterpOrder+1 ), ED%InputTimes( p_FAST%InterpOrder+1 ), ED%Output( p_FAST%InterpOrder+1 ),STAT = ErrStat2 ) + ALLOCATE( ED%Input( p_FAST%InterpOrder+1 ), ED%InputTimes( p_FAST%InterpOrder+1 ),STAT = ErrStat2 ) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal,"Error allocating ED%Input, ED%Output, and ED%InputTimes.",ErrStat,ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal,"Error allocating ED%Input and ED%InputTimes.",ErrStat,ErrMsg,RoutineName) CALL Cleanup() RETURN END IF - InitInData_ED%Linearize = p_FAST%Linearize - InitInData_ED%InputFile = p_FAST%EDFile + Init%InData_ED%Linearize = p_FAST%Linearize + Init%InData_ED%InputFile = p_FAST%EDFile IF ( p_FAST%CompAero == Module_AD14 ) THEN - InitInData_ED%ADInputFile = p_FAST%AeroFile + Init%InData_ED%ADInputFile = p_FAST%AeroFile ELSE - InitInData_ED%ADInputFile = "" + Init%InData_ED%ADInputFile = "" END IF - InitInData_ED%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_ED)) - InitInData_ED%CompElast = p_FAST%CompElast == Module_ED + Init%InData_ED%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_ED)) + Init%InData_ED%CompElast = p_FAST%CompElast == Module_ED - CALL ED_Init( InitInData_ED, ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), & - ED%Output(1), ED%m, p_FAST%dt_module( MODULE_ED ), InitOutData_ED, ErrStat2, ErrMsg2 ) + CALL ED_Init( Init%InData_ED, ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), & + ED%y, ED%m, p_FAST%dt_module( MODULE_ED ), Init%OutData_ED, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) p_FAST%ModuleInitialized(Module_ED) = .TRUE. @@ -297,16 +253,16 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(ED).", ErrStat, ErrMsg, RoutineName ) else - if (allocated(InitOutData_ED%LinNames_y)) call move_alloc(InitOutData_ED%LinNames_y,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%Names_y) - if (allocated(InitOutData_ED%LinNames_x)) call move_alloc(InitOutData_ED%LinNames_x,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%Names_x) - if (allocated(InitOutData_ED%LinNames_u)) call move_alloc(InitOutData_ED%LinNames_u,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%Names_u) - if (allocated(InitOutData_ED%RotFrame_y)) call move_alloc(InitOutData_ED%RotFrame_y,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%RotFrame_y) - if (allocated(InitOutData_ED%RotFrame_x)) call move_alloc(InitOutData_ED%RotFrame_x,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%RotFrame_x) - if (allocated(InitOutData_ED%DerivOrder_x)) call move_alloc(InitOutData_ED%DerivOrder_x,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%DerivOrder_x) - if (allocated(InitOutData_ED%RotFrame_u)) call move_alloc(InitOutData_ED%RotFrame_u,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%RotFrame_u) - if (allocated(InitOutData_ED%IsLoad_u )) call move_alloc(InitOutData_ED%IsLoad_u ,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%IsLoad_u ) + if (allocated(Init%OutData_ED%LinNames_y)) call move_alloc(Init%OutData_ED%LinNames_y,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%Names_y) + if (allocated(Init%OutData_ED%LinNames_x)) call move_alloc(Init%OutData_ED%LinNames_x,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%Names_x) + if (allocated(Init%OutData_ED%LinNames_u)) call move_alloc(Init%OutData_ED%LinNames_u,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%Names_u) + if (allocated(Init%OutData_ED%RotFrame_y)) call move_alloc(Init%OutData_ED%RotFrame_y,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%RotFrame_y) + if (allocated(Init%OutData_ED%RotFrame_x)) call move_alloc(Init%OutData_ED%RotFrame_x,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%RotFrame_x) + if (allocated(Init%OutData_ED%DerivOrder_x)) call move_alloc(Init%OutData_ED%DerivOrder_x,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%DerivOrder_x) + if (allocated(Init%OutData_ED%RotFrame_u)) call move_alloc(Init%OutData_ED%RotFrame_u,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%RotFrame_u) + if (allocated(Init%OutData_ED%IsLoad_u )) call move_alloc(Init%OutData_ED%IsLoad_u ,y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%IsLoad_u ) - if (allocated(InitOutData_ED%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%NumOutputs = size(InitOutData_ED%WriteOutputHdr) + if (allocated(Init%OutData_ED%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_ED)%Instance(1)%NumOutputs = size(Init%OutData_ED%WriteOutputHdr) end if IF (ErrStat >= AbortErrLev) THEN @@ -314,11 +270,22 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, RETURN END IF + if (p_FAST%CalcSteady) then + if ( EqualRealNos(Init%OutData_ED%RotSpeed, 0.0_ReKi) ) then + p_FAST%TrimCase = TrimCase_none + p_FAST%NLinTimes = 1 + p_FAST%LinInterpOrder = 0 ! constant values + elseif ( Init%OutData_ED%isFixed_GenDOF ) then + p_FAST%TrimCase = TrimCase_none + end if + end if + + ! ........................ ! initialize BeamDyn ! ........................ IF ( p_FAST%CompElast == Module_BD ) THEN - p_FAST%nBeams = InitOutData_ED%NumBl ! initialize number of BeamDyn instances = number of blades + p_FAST%nBeams = Init%OutData_ED%NumBl ! initialize number of BeamDyn instances = number of blades ELSE p_FAST%nBeams = 0 END IF @@ -338,7 +305,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, BD%u( p_FAST%nBeams ), & BD%y( p_FAST%nBeams ), & BD%m( p_FAST%nBeams ), & - InitOutData_BD( p_FAST%nBeams ), & + Init%OutData_BD(p_FAST%nBeams ), & STAT = ErrStat2 ) IF (ErrStat2 /= 0) THEN CALL SetErrStat(ErrID_Fatal,"Error allocating BeamDyn state, input, and output data.",ErrStat,ErrMsg,RoutineName) @@ -348,16 +315,16 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, IF (p_FAST%CompElast == Module_BD) THEN - InitInData_BD%DynamicSolve = .TRUE. ! FAST can only couple to BeamDyn when dynamic solve is used. + Init%InData_BD%DynamicSolve = .TRUE. ! FAST can only couple to BeamDyn when dynamic solve is used. - InitInData_BD%Linearize = p_FAST%Linearize - InitInData_BD%gravity = (/ 0.0_ReKi, 0.0_ReKi, -InitOutData_ED%Gravity /) ! "Gravitational acceleration" m/s^2 + Init%InData_BD%Linearize = p_FAST%Linearize + Init%InData_BD%gravity = (/ 0.0_ReKi, 0.0_ReKi, -Init%OutData_ED%Gravity /) ! "Gravitational acceleration" m/s^2 ! now initialize BeamDyn for all beams dt_BD = p_FAST%dt_module( MODULE_BD ) - InitInData_BD%HubPos = ED%Output(1)%HubPtMotion%Position(:,1) - InitInData_BD%HubRot = ED%Output(1)%HubPtMotion%RefOrientation(:,:,1) + Init%InData_BD%HubPos = ED%y%HubPtMotion%Position(:,1) + Init%InData_BD%HubRot = ED%y%HubPtMotion%RefOrientation(:,:,1) p_FAST%BD_OutputSibling = .true. @@ -369,21 +336,21 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, end if DO k=1,p_FAST%nBeams - InitInData_BD%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_BD))//TRIM( Num2LStr(k) ) + Init%InData_BD%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_BD))//TRIM( Num2LStr(k) ) - InitInData_BD%InputFile = p_FAST%BDBldFile(k) + Init%InData_BD%InputFile = p_FAST%BDBldFile(k) - InitInData_BD%GlbPos = ED%Output(1)%BladeRootMotion(k)%Position(:,1) ! {:} - - "Initial Position Vector of the local blade coordinate system" - InitInData_BD%GlbRot = ED%Output(1)%BladeRootMotion(k)%RefOrientation(:,:,1) ! {:}{:} - - "Initial direction cosine matrix of the local blade coordinate system" + Init%InData_BD%GlbPos = ED%y%BladeRootMotion(k)%Position(:,1) ! {:} - - "Initial Position Vector of the local blade coordinate system" + Init%InData_BD%GlbRot = ED%y%BladeRootMotion(k)%RefOrientation(:,:,1) ! {:}{:} - - "Initial direction cosine matrix of the local blade coordinate system" - InitInData_BD%RootDisp = ED%Output(1)%BladeRootMotion(k)%TranslationDisp(:,1) ! {:} - - "Initial root displacement" - InitInData_BD%RootOri = ED%Output(1)%BladeRootMotion(k)%Orientation(:,:,1) ! {:}{:} - - "Initial root orientation" - InitInData_BD%RootVel(1:3) = ED%Output(1)%BladeRootMotion(k)%TranslationVel(:,1) ! {:} - - "Initial root velocities and angular veolcities" - InitInData_BD%RootVel(4:6) = ED%Output(1)%BladeRootMotion(k)%RotationVel(:,1) ! {:} - - "Initial root velocities and angular veolcities" + Init%InData_BD%RootDisp = ED%y%BladeRootMotion(k)%TranslationDisp(:,1) ! {:} - - "Initial root displacement" + Init%InData_BD%RootOri = ED%y%BladeRootMotion(k)%Orientation(:,:,1) ! {:}{:} - - "Initial root orientation" + Init%InData_BD%RootVel(1:3) = ED%y%BladeRootMotion(k)%TranslationVel(:,1) ! {:} - - "Initial root velocities and angular veolcities" + Init%InData_BD%RootVel(4:6) = ED%y%BladeRootMotion(k)%RotationVel(:,1) ! {:} - - "Initial root velocities and angular veolcities" - CALL BD_Init( InitInData_BD, BD%Input(1,k), BD%p(k), BD%x(k,STATE_CURR), BD%xd(k,STATE_CURR), BD%z(k,STATE_CURR), & - BD%OtherSt(k,STATE_CURR), BD%y(k), BD%m(k), dt_BD, InitOutData_BD(k), ErrStat2, ErrMsg2 ) + CALL BD_Init( Init%InData_BD, BD%Input(1,k), BD%p(k), BD%x(k,STATE_CURR), BD%xd(k,STATE_CURR), BD%z(k,STATE_CURR), & + BD%OtherSt(k,STATE_CURR), BD%y(k), BD%m(k), dt_BD, Init%OutData_BD(k), ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) !bjj: we're going to force this to have the same timestep because I don't want to have to deal with n BD modules with n timesteps. @@ -396,27 +363,22 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ELSEIF ( .NOT. EqualRealNos( p_FAST%dt_module( MODULE_BD ),dt_BD )) THEN CALL SetErrStat(ErrID_Fatal,"All instances of BeamDyn (one per blade) must have the same time step.",ErrStat,ErrMsg,RoutineName) END IF - - ! BeamDyn shouldn't be run in static mode when coupled with FAST - if (BD%p(k)%analysis_type == BD_STATIC_ANALYSIS) then ! static - CALL SetErrStat(ErrID_Fatal,"BeamDyn cannot perform static analysis when coupled with FAST.",ErrStat,ErrMsg,RoutineName) - end if ! We're going to do fewer computations if the BD input and output meshes that couple to AD are siblings: if (BD%p(k)%BldMotionNodeLoc /= BD_MESH_QP) p_FAST%BD_OutputSibling = .false. if (ErrStat>=AbortErrLev) exit !exit this loop so we don't get p_FAST%nBeams of the same errors - if (allocated(InitOutData_BD(k)%LinNames_y)) call move_alloc(InitOutData_BD(k)%LinNames_y, y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%Names_y ) - if (allocated(InitOutData_BD(k)%LinNames_x)) call move_alloc(InitOutData_BD(k)%LinNames_x, y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%Names_x ) - if (allocated(InitOutData_BD(k)%LinNames_u)) call move_alloc(InitOutData_BD(k)%LinNames_u, y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%Names_u ) - if (allocated(InitOutData_BD(k)%RotFrame_y)) call move_alloc(InitOutData_BD(k)%RotFrame_y, y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%RotFrame_y ) - if (allocated(InitOutData_BD(k)%RotFrame_x)) call move_alloc(InitOutData_BD(k)%RotFrame_x, y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%RotFrame_x ) - if (allocated(InitOutData_BD(k)%RotFrame_u)) call move_alloc(InitOutData_BD(k)%RotFrame_u, y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%RotFrame_u ) - if (allocated(InitOutData_BD(k)%IsLoad_u )) call move_alloc(InitOutData_BD(k)%IsLoad_u , y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%IsLoad_u ) - if (allocated(InitOutData_BD(k)%DerivOrder_x )) call move_alloc(InitOutData_BD(k)%DerivOrder_x , y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%DerivOrder_x ) + if (allocated(Init%OutData_BD(k)%LinNames_y)) call move_alloc(Init%OutData_BD(k)%LinNames_y, y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%Names_y ) + if (allocated(Init%OutData_BD(k)%LinNames_x)) call move_alloc(Init%OutData_BD(k)%LinNames_x, y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%Names_x ) + if (allocated(Init%OutData_BD(k)%LinNames_u)) call move_alloc(Init%OutData_BD(k)%LinNames_u, y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%Names_u ) + if (allocated(Init%OutData_BD(k)%RotFrame_y)) call move_alloc(Init%OutData_BD(k)%RotFrame_y, y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%RotFrame_y ) + if (allocated(Init%OutData_BD(k)%RotFrame_x)) call move_alloc(Init%OutData_BD(k)%RotFrame_x, y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%RotFrame_x ) + if (allocated(Init%OutData_BD(k)%RotFrame_u)) call move_alloc(Init%OutData_BD(k)%RotFrame_u, y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%RotFrame_u ) + if (allocated(Init%OutData_BD(k)%IsLoad_u )) call move_alloc(Init%OutData_BD(k)%IsLoad_u , y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%IsLoad_u ) + if (allocated(Init%OutData_BD(k)%DerivOrder_x )) call move_alloc(Init%OutData_BD(k)%DerivOrder_x , y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%DerivOrder_x ) - if (allocated(InitOutData_BD(k)%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%NumOutputs = size(InitOutData_BD(k)%WriteOutputHdr) + if (allocated(Init%OutData_BD(k)%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_BD)%Instance(k)%NumOutputs = size(Init%OutData_BD(k)%WriteOutputHdr) END DO @@ -448,11 +410,11 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, IF ( p_FAST%CompAero == Module_AD14 ) THEN - CALL AD_SetInitInput(InitInData_AD14, InitOutData_ED, ED%Output(1), p_FAST, ErrStat2, ErrMsg2) ! set the values in InitInData_AD14 + CALL AD_SetInitInput(Init%InData_AD14, Init%OutData_ED, ED%y, p_FAST, ErrStat2, ErrMsg2) ! set the values in Init%InData_AD14 CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL AD14_Init( InitInData_AD14, AD14%Input(1), AD14%p, AD14%x(STATE_CURR), AD14%xd(STATE_CURR), AD14%z(STATE_CURR), & - AD14%OtherSt(STATE_CURR), AD14%y, AD14%m, p_FAST%dt_module( MODULE_AD14 ), InitOutData_AD14, ErrStat2, ErrMsg2 ) + CALL AD14_Init( Init%InData_AD14, AD14%Input(1), AD14%p, AD14%x(STATE_CURR), AD14%xd(STATE_CURR), AD14%z(STATE_CURR), & + AD14%OtherSt(STATE_CURR), AD14%y, AD14%m, p_FAST%dt_module( MODULE_AD14 ), Init%OutData_AD14, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) p_FAST%ModuleInitialized(Module_AD14) = .TRUE. @@ -465,7 +427,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, CALL SetErrStat(ErrID_Fatal,'AeroDyn v14 tower influence model "NEWTOWER" is invalid for models of floating offshore turbines.',ErrStat,ErrMsg,RoutineName) END IF - AirDens = InitOutData_AD14%AirDens + AirDens = Init%OutData_AD14%AirDens IF (ErrStat >= AbortErrLev) THEN CALL Cleanup() @@ -476,30 +438,30 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! set initialization data for AD - CALL AllocAry( InitInData_AD%BladeRootPosition, 3, InitOutData_ED%NumBl, 'InitInData_AD%BladeRootPosition', errStat2, ErrMsg2) + CALL AllocAry( Init%InData_AD%BladeRootPosition, 3, Init%OutData_ED%NumBl, 'Init%InData_AD%BladeRootPosition', errStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL AllocAry( InitInData_AD%BladeRootOrientation,3, 3, InitOutData_ED%NumBl, 'InitInData_AD%BladeRootOrientation', errStat2, ErrMsg2) + CALL AllocAry( Init%InData_AD%BladeRootOrientation,3, 3, Init%OutData_ED%NumBl, 'Init%InData_AD%BladeRootOrientation', errStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF (ErrStat >= AbortErrLev) THEN CALL Cleanup() RETURN END IF - InitInData_AD%Gravity = InitOutData_ED%Gravity - InitInData_AD%Linearize = p_FAST%Linearize - InitInData_AD%InputFile = p_FAST%AeroFile - InitInData_AD%NumBlades = InitOutData_ED%NumBl - InitInData_AD%RootName = p_FAST%OutFileRoot - InitInData_AD%HubPosition = ED%Output(1)%HubPtMotion%Position(:,1) - InitInData_AD%HubOrientation = ED%Output(1)%HubPtMotion%RefOrientation(:,:,1) - - do k=1,InitOutData_ED%NumBl - InitInData_AD%BladeRootPosition(:,k) = ED%Output(1)%BladeRootMotion(k)%Position(:,1) - InitInData_AD%BladeRootOrientation(:,:,k) = ED%Output(1)%BladeRootMotion(k)%RefOrientation(:,:,1) + Init%InData_AD%Gravity = Init%OutData_ED%Gravity + Init%InData_AD%Linearize = p_FAST%Linearize + Init%InData_AD%InputFile = p_FAST%AeroFile + Init%InData_AD%NumBlades = Init%OutData_ED%NumBl + Init%InData_AD%RootName = p_FAST%OutFileRoot + Init%InData_AD%HubPosition = ED%y%HubPtMotion%Position(:,1) + Init%InData_AD%HubOrientation = ED%y%HubPtMotion%RefOrientation(:,:,1) + + do k=1,Init%OutData_ED%NumBl + Init%InData_AD%BladeRootPosition(:,k) = ED%y%BladeRootMotion(k)%Position(:,1) + Init%InData_AD%BladeRootOrientation(:,:,k) = ED%y%BladeRootMotion(k)%RefOrientation(:,:,1) end do - CALL AD_Init( InitInData_AD, AD%Input(1), AD%p, AD%x(STATE_CURR), AD%xd(STATE_CURR), AD%z(STATE_CURR), & - AD%OtherSt(STATE_CURR), AD%y, AD%m, p_FAST%dt_module( MODULE_AD ), InitOutData_AD, ErrStat2, ErrMsg2 ) + CALL AD_Init( Init%InData_AD, AD%Input(1), AD%p, AD%x(STATE_CURR), AD%xd(STATE_CURR), AD%z(STATE_CURR), & + AD%OtherSt(STATE_CURR), AD%y, AD%m, p_FAST%dt_module( MODULE_AD ), Init%OutData_AD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) p_FAST%ModuleInitialized(Module_AD) = .TRUE. @@ -510,15 +472,15 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, if (ErrStat2 /= 0 ) then call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(AD).", ErrStat, ErrMsg, RoutineName ) else - if (allocated(InitOutData_AD%LinNames_u)) call move_alloc(InitOutData_AD%LinNames_u,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%Names_u ) - if (allocated(InitOutData_AD%LinNames_y)) call move_alloc(InitOutData_AD%LinNames_y,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%Names_y ) - if (allocated(InitOutData_AD%LinNames_z)) call move_alloc(InitOutData_AD%LinNames_z,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%Names_z ) - if (allocated(InitOutData_AD%RotFrame_u)) call move_alloc(InitOutData_AD%RotFrame_u,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%RotFrame_u ) - if (allocated(InitOutData_AD%RotFrame_y)) call move_alloc(InitOutData_AD%RotFrame_y,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%RotFrame_y ) - if (allocated(InitOutData_AD%RotFrame_z)) call move_alloc(InitOutData_AD%RotFrame_z,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%RotFrame_z ) - if (allocated(InitOutData_AD%IsLoad_u )) call move_alloc(InitOutData_AD%IsLoad_u ,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%IsLoad_u ) + if (allocated(Init%OutData_AD%LinNames_u)) call move_alloc(Init%OutData_AD%LinNames_u,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%Names_u ) + if (allocated(Init%OutData_AD%LinNames_y)) call move_alloc(Init%OutData_AD%LinNames_y,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%Names_y ) + if (allocated(Init%OutData_AD%LinNames_z)) call move_alloc(Init%OutData_AD%LinNames_z,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%Names_z ) + if (allocated(Init%OutData_AD%RotFrame_u)) call move_alloc(Init%OutData_AD%RotFrame_u,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%RotFrame_u ) + if (allocated(Init%OutData_AD%RotFrame_y)) call move_alloc(Init%OutData_AD%RotFrame_y,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%RotFrame_y ) + if (allocated(Init%OutData_AD%RotFrame_z)) call move_alloc(Init%OutData_AD%RotFrame_z,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%RotFrame_z ) + if (allocated(Init%OutData_AD%IsLoad_u )) call move_alloc(Init%OutData_AD%IsLoad_u ,y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%IsLoad_u ) - if (allocated(InitOutData_AD%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%NumOutputs = size(InitOutData_AD%WriteOutputHdr) + if (allocated(Init%OutData_AD%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_AD)%Instance(1)%NumOutputs = size(Init%OutData_AD%WriteOutputHdr) end if IF (ErrStat >= AbortErrLev) THEN @@ -526,7 +488,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, RETURN END IF - AirDens = InitOutData_AD%AirDens + AirDens = Init%OutData_AD%AirDens ELSE AirDens = 0.0_ReKi @@ -545,46 +507,47 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, IF ( p_FAST%CompInflow == Module_IfW ) THEN - InitInData_IfW%Linearize = p_FAST%Linearize - InitInData_IfW%InputFileName = p_FAST%InflowFile - InitInData_IfW%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_IfW)) - InitInData_IfW%UseInputFile = .TRUE. + Init%InData_IfW%Linearize = p_FAST%Linearize + Init%InData_IfW%InputFileName = p_FAST%InflowFile + Init%InData_IfW%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_IfW)) + Init%InData_IfW%UseInputFile = .TRUE. - InitInData_IfW%NumWindPoints = 0 - IF ( p_FAST%CompServo == Module_SrvD ) InitInData_IfW%NumWindPoints = InitInData_IfW%NumWindPoints + 1 + Init%InData_IfW%NumWindPoints = 0 + IF ( p_FAST%CompServo == Module_SrvD ) Init%InData_IfW%NumWindPoints = Init%InData_IfW%NumWindPoints + 1 IF ( p_FAST%CompAero == Module_AD14 ) THEN - InitInData_IfW%NumWindPoints = InitInData_IfW%NumWindPoints + InitOutData_ED%NumBl * AD14%Input(1)%InputMarkers(1)%NNodes + AD14%Input(1)%Twr_InputMarkers%NNodes + Init%InData_IfW%NumWindPoints = Init%InData_IfW%NumWindPoints + Init%OutData_ED%NumBl * AD14%Input(1)%InputMarkers(1)%NNodes + AD14%Input(1)%Twr_InputMarkers%NNodes ELSEIF ( p_FAST%CompAero == Module_AD ) THEN - InitInData_IfW%NumWindPoints = InitInData_IfW%NumWindPoints + AD%Input(1)%TowerMotion%NNodes - DO k=1,InitOutData_ED%NumBl - InitInData_IfW%NumWindPoints = InitInData_IfW%NumWindPoints + AD%Input(1)%BladeMotion(k)%NNodes + Init%InData_IfW%NumWindPoints = Init%InData_IfW%NumWindPoints + AD%Input(1)%TowerMotion%NNodes + DO k=1,Init%OutData_ED%NumBl + Init%InData_IfW%NumWindPoints = Init%InData_IfW%NumWindPoints + AD%Input(1)%BladeMotion(k)%NNodes END DO END IF ! lidar - InitInData_IfW%lidar%Tmax = p_FAST%TMax - InitInData_IfW%lidar%HubPosition = ED%Output(1)%HubPtMotion%Position(:,1) + Init%InData_IfW%lidar%Tmax = p_FAST%TMax + Init%InData_IfW%lidar%HubPosition = ED%y%HubPtMotion%Position(:,1) + IF ( PRESENT(ExternInitData) ) THEN - InitInData_IfW%Use4Dext = ExternInitData%FarmIntegration + Init%InData_IfW%Use4Dext = ExternInitData%FarmIntegration - if (InitInData_IfW%Use4Dext) then - InitInData_IfW%FDext%n = ExternInitData%windGrid_n - InitInData_IfW%FDext%delta = ExternInitData%windGrid_delta - InitInData_IfW%FDext%pZero = ExternInitData%windGrid_pZero + if (Init%InData_IfW%Use4Dext) then + Init%InData_IfW%FDext%n = ExternInitData%windGrid_n + Init%InData_IfW%FDext%delta = ExternInitData%windGrid_delta + Init%InData_IfW%FDext%pZero = ExternInitData%windGrid_pZero end if ! bjj: these lidar inputs should come from an InflowWind input file; I'm hard coding them here for now - InitInData_IfW%lidar%SensorType = ExternInitData%SensorType - InitInData_IfW%lidar%LidRadialVel = ExternInitData%LidRadialVel - InitInData_IfW%lidar%RotorApexOffsetPos = 0.0 - InitInData_IfW%lidar%NumPulseGate = 0 + Init%InData_IfW%lidar%SensorType = ExternInitData%SensorType + Init%InData_IfW%lidar%LidRadialVel = ExternInitData%LidRadialVel + Init%InData_IfW%lidar%RotorApexOffsetPos = 0.0 + Init%InData_IfW%lidar%NumPulseGate = 0 ELSE - InitInData_IfW%lidar%SensorType = SensorType_None - InitInData_IfW%Use4Dext = .false. + Init%InData_IfW%lidar%SensorType = SensorType_None + Init%InData_IfW%Use4Dext = .false. END IF - CALL InflowWind_Init( InitInData_IfW, IfW%Input(1), IfW%p, IfW%x(STATE_CURR), IfW%xd(STATE_CURR), IfW%z(STATE_CURR), & - IfW%OtherSt(STATE_CURR), IfW%y, IfW%m, p_FAST%dt_module( MODULE_IfW ), InitOutData_IfW, ErrStat2, ErrMsg2 ) + CALL InflowWind_Init( Init%InData_IfW, IfW%Input(1), IfW%p, IfW%x(STATE_CURR), IfW%xd(STATE_CURR), IfW%z(STATE_CURR), & + IfW%OtherSt(STATE_CURR), IfW%y, IfW%m, p_FAST%dt_module( MODULE_IfW ), Init%OutData_IfW, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) p_FAST%ModuleInitialized(Module_IfW) = .TRUE. @@ -595,13 +558,14 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, if (ErrStat2 /= 0 ) then call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(IfW).", ErrStat, ErrMsg, RoutineName ) else - if (allocated(InitOutData_IfW%LinNames_y)) call move_alloc(InitOutData_IfW%LinNames_y,y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%Names_y ) - if (allocated(InitOutData_IfW%LinNames_u)) call move_alloc(InitOutData_IfW%LinNames_u,y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%Names_u ) - if (allocated(InitOutData_IfW%RotFrame_y)) call move_alloc(InitOutData_IfW%RotFrame_y,y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%RotFrame_y ) - if (allocated(InitOutData_IfW%RotFrame_u)) call move_alloc(InitOutData_IfW%RotFrame_u,y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%RotFrame_u ) - if (allocated(InitOutData_IfW%IsLoad_u )) call move_alloc(InitOutData_IfW%IsLoad_u ,y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%IsLoad_u ) - - if (allocated(InitOutData_IfW%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%NumOutputs = size(InitOutData_IfW%WriteOutputHdr) + if (allocated(Init%OutData_IfW%LinNames_y)) call move_alloc(Init%OutData_IfW%LinNames_y,y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%Names_y ) + if (allocated(Init%OutData_IfW%LinNames_u)) call move_alloc(Init%OutData_IfW%LinNames_u,y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%Names_u ) + if (allocated(Init%OutData_IfW%RotFrame_y)) call move_alloc(Init%OutData_IfW%RotFrame_y,y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%RotFrame_y ) + if (allocated(Init%OutData_IfW%RotFrame_u)) call move_alloc(Init%OutData_IfW%RotFrame_u,y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%RotFrame_u ) + if (allocated(Init%OutData_IfW%IsLoad_u )) call move_alloc(Init%OutData_IfW%IsLoad_u ,y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%IsLoad_u ) + + if (allocated(Init%OutData_IfW%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_IfW)%Instance(1)%NumOutputs = size(Init%OutData_IfW%WriteOutputHdr) + y_FAST%Lin%WindSpeed = Init%OutData_IfW%WindFileInfo%MWS end if IF (ErrStat >= AbortErrLev) THEN @@ -612,29 +576,29 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ELSEIF ( p_FAST%CompInflow == Module_OpFM ) THEN IF ( PRESENT(ExternInitData) ) THEN - InitInData_OpFM%NumSC2Ctrl = ExternInitData%NumSC2Ctrl - InitInData_OpFM%NumCtrl2SC = ExternInitData%NumCtrl2SC - InitInData_OpFM%NumActForcePtsBlade = ExternInitData%NumActForcePtsBlade - InitInData_OpFM%NumActForcePtsTower = ExternInitData%NumActForcePtsTower + Init%InData_OpFM%NumSC2Ctrl = ExternInitData%NumSC2Ctrl + Init%InData_OpFM%NumCtrl2SC = ExternInitData%NumCtrl2SC + Init%InData_OpFM%NumActForcePtsBlade = ExternInitData%NumActForcePtsBlade + Init%InData_OpFM%NumActForcePtsTower = ExternInitData%NumActForcePtsTower ELSE CALL SetErrStat( ErrID_Fatal, 'OpenFOAM integration can be used only with external input data (not the stand-alone executable).', ErrStat, ErrMsg, RoutineName ) CALL Cleanup() RETURN END IF - InitInData_OpFM%BladeLength = InitOutData_ED%BladeLength - InitInData_OpFM%TowerHeight = InitOutData_ED%TowerHeight - InitInData_OpFM%TowerBaseHeight = InitOutData_ED%TowerBaseHeight - ALLOCATE(InitInData_OpFM%StructBldRNodes( SIZE(InitOutData_ED%BldRNodes)), STAT=ErrStat2) - InitInData_OpFM%StructBldRNodes(:) = InitOutData_ED%BldRNodes(:) - ALLOCATE(InitInData_OpFM%StructTwrHNodes( SIZE(InitOutData_ED%TwrHNodes)), STAT=ErrStat2) - InitInData_OpFM%StructTwrHNodes(:) = InitOutData_ED%TwrHNodes(:) + Init%InData_OpFM%BladeLength = Init%OutData_ED%BladeLength + Init%InData_OpFM%TowerHeight = Init%OutData_ED%TowerHeight + Init%InData_OpFM%TowerBaseHeight = Init%OutData_ED%TowerBaseHeight + ALLOCATE(Init%InData_OpFM%StructBldRNodes( SIZE(Init%OutData_ED%BldRNodes)), STAT=ErrStat2) + Init%InData_OpFM%StructBldRNodes(:) = Init%OutData_ED%BldRNodes(:) + ALLOCATE(Init%InData_OpFM%StructTwrHNodes( SIZE(Init%OutData_ED%TwrHNodes)), STAT=ErrStat2) + Init%InData_OpFM%StructTwrHNodes(:) = Init%OutData_ED%TwrHNodes(:) IF (ErrStat2 /= 0) THEN CALL SetErrStat(ErrID_Fatal,"Error allocating OpFM%InitInput.",ErrStat,ErrMsg,RoutineName) CALL Cleanup() RETURN END IF ! set up the data structures for integration with OpenFOAM - CALL Init_OpFM( InitInData_OpFM, p_FAST, AirDens, AD14%Input(1), AD%Input(1), InitOutData_AD, AD%y, ED%Output(1), OpFM, InitOutData_OpFM, ErrStat2, ErrMsg2 ) + CALL Init_OpFM( Init%InData_OpFM, p_FAST, AirDens, AD14%Input(1), AD%Input(1), Init%OutData_AD, AD%y, ED%y, OpFM, Init%OutData_OpFM, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF (ErrStat >= AbortErrLev) THEN @@ -643,25 +607,25 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, END IF !bjj: fix me!!! to do - InitOutData_IfW%WindFileInfo%MWS = 0.0_ReKi + Init%OutData_IfW%WindFileInfo%MWS = 0.0_ReKi ELSE - InitOutData_IfW%WindFileInfo%MWS = 0.0_ReKi + Init%OutData_IfW%WindFileInfo%MWS = 0.0_ReKi END IF ! CompInflow ! ........................ ! initialize SuperController ! ........................ IF ( PRESENT(ExternInitData) ) THEN - InitInData_SC%NumSC2Ctrl = ExternInitData%NumSC2Ctrl - InitInData_SC%NumCtrl2SC = ExternInitData%NumCtrl2SC + Init%InData_SC%NumSC2Ctrl = ExternInitData%NumSC2Ctrl + Init%InData_SC%NumCtrl2SC = ExternInitData%NumCtrl2SC ELSE - InitInData_SC%NumSC2Ctrl = 0 - InitInData_SC%NumCtrl2SC = 0 + Init%InData_SC%NumSC2Ctrl = 0 + Init%InData_SC%NumCtrl2SC = 0 END IF ! set up the data structures for integration with supercontroller - CALL Init_SC( InitInData_SC, SC, ErrStat2, ErrMsg2 ) + CALL Init_SC( Init%InData_SC, SC, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF (ErrStat >= AbortErrLev) THEN @@ -677,7 +641,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, IF ( p_FAST%CompAero == Module_AD14 ) THEN IF (AD14%p%DynInfl) THEN - IF ( InitOutData_IfW%WindFileInfo%MWS < 8.0 ) THEN + IF ( Init%OutData_IfW%WindFileInfo%MWS < 8.0 ) THEN CALL SetErrStat(ErrID_Fatal,'AeroDyn v14 "DYNINFL" InfModel is invalid for models with wind speeds less than 8 m/s.',ErrStat,ErrMsg,RoutineName) !CALL SetErrStat(ErrID_Info,'Estimated average inflow wind speed is less than 8 m/s. Dynamic Inflow will be turned off.',ErrStat,ErrMess,RoutineName ) END IF @@ -696,35 +660,43 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, END IF IF ( p_FAST%CompServo == Module_SrvD ) THEN - InitInData_SrvD%InputFile = p_FAST%ServoFile - InitInData_SrvD%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_SrvD)) - InitInData_SrvD%NumBl = InitOutData_ED%NumBl - InitInData_SrvD%gravity = InitOutData_ED%gravity - InitInData_SrvD%r_N_O_G = ED%Input(1)%NacelleLoads%Position(:,1) - InitInData_SrvD%r_TwrBase = InitOutData_ED%TwrBasePos - InitInData_SrvD%TMax = p_FAST%TMax - InitInData_SrvD%AirDens = AirDens - InitInData_SrvD%AvgWindSpeed = InitOutData_IfW%WindFileInfo%MWS - InitInData_SrvD%Linearize = p_FAST%Linearize + Init%InData_SrvD%InputFile = p_FAST%ServoFile + Init%InData_SrvD%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_SrvD)) + Init%InData_SrvD%NumBl = Init%OutData_ED%NumBl + Init%InData_SrvD%gravity = Init%OutData_ED%gravity + Init%InData_SrvD%r_N_O_G = ED%Input(1)%NacelleLoads%Position(:,1) + Init%InData_SrvD%r_TwrBase = Init%OutData_ED%TwrBasePos + Init%InData_SrvD%TMax = p_FAST%TMax + Init%InData_SrvD%AirDens = AirDens + Init%InData_SrvD%AvgWindSpeed = Init%OutData_IfW%WindFileInfo%MWS + Init%InData_SrvD%Linearize = p_FAST%Linearize + Init%InData_SrvD%TrimCase = p_FAST%TrimCase + Init%InData_SrvD%TrimGain = p_FAST%TrimGain + Init%InData_SrvD%RotSpeedRef = Init%OutData_ED%RotSpeed IF ( PRESENT(ExternInitData) ) THEN - InitInData_SrvD%NumSC2Ctrl = ExternInitData%NumSC2Ctrl - InitInData_SrvD%NumCtrl2SC = ExternInitData%NumCtrl2SC + Init%InData_SrvD%NumSC2Ctrl = ExternInitData%NumSC2Ctrl + Init%InData_SrvD%NumCtrl2SC = ExternInitData%NumCtrl2SC ELSE - InitInData_SrvD%NumSC2Ctrl = 0 - InitInData_SrvD%NumCtrl2SC = 0 + Init%InData_SrvD%NumSC2Ctrl = 0 + Init%InData_SrvD%NumCtrl2SC = 0 END IF - CALL AllocAry(InitInData_SrvD%BlPitchInit, InitOutData_ED%NumBl, 'BlPitchInit', ErrStat2, ErrMsg2) + CALL AllocAry(Init%InData_SrvD%BlPitchInit, Init%OutData_ED%NumBl, 'BlPitchInit', ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - InitInData_SrvD%BlPitchInit = InitOutData_ED%BlPitch - CALL SrvD_Init( InitInData_SrvD, SrvD%Input(1), SrvD%p, SrvD%x(STATE_CURR), SrvD%xd(STATE_CURR), SrvD%z(STATE_CURR), & - SrvD%OtherSt(STATE_CURR), SrvD%y, SrvD%m, p_FAST%dt_module( MODULE_SrvD ), InitOutData_SrvD, ErrStat2, ErrMsg2 ) + if (ErrStat >= abortErrLev) then ! make sure allocatable arrays are valid before setting them + CALL Cleanup() + RETURN + end if + + Init%InData_SrvD%BlPitchInit = Init%OutData_ED%BlPitch + CALL SrvD_Init( Init%InData_SrvD, SrvD%Input(1), SrvD%p, SrvD%x(STATE_CURR), SrvD%xd(STATE_CURR), SrvD%z(STATE_CURR), & + SrvD%OtherSt(STATE_CURR), SrvD%y, SrvD%m, p_FAST%dt_module( MODULE_SrvD ), Init%OutData_SrvD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) p_FAST%ModuleInitialized(Module_SrvD) = .TRUE. - !IF ( InitOutData_SrvD%CouplingScheme == ExplicitLoose ) THEN ... bjj: abort if we're doing anything else! + !IF ( Init%OutData_SrvD%CouplingScheme == ExplicitLoose ) THEN ... bjj: abort if we're doing anything else! CALL SetModuleSubstepTime(Module_SrvD, p_FAST, y_FAST, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) @@ -735,13 +707,13 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, if (ErrStat2 /= 0 ) then call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(SrvD).", ErrStat, ErrMsg, RoutineName ) else - if (allocated(InitOutData_SrvD%LinNames_y)) call move_alloc(InitOutData_SrvD%LinNames_y,y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%Names_y ) - if (allocated(InitOutData_SrvD%LinNames_u)) call move_alloc(InitOutData_SrvD%LinNames_u,y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%Names_u ) - if (allocated(InitOutData_SrvD%RotFrame_y)) call move_alloc(InitOutData_SrvD%RotFrame_y,y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%RotFrame_y ) - if (allocated(InitOutData_SrvD%RotFrame_u)) call move_alloc(InitOutData_SrvD%RotFrame_u,y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%RotFrame_u ) - if (allocated(InitOutData_SrvD%IsLoad_u )) call move_alloc(InitOutData_SrvD%IsLoad_u ,y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%IsLoad_u ) + if (allocated(Init%OutData_SrvD%LinNames_y)) call move_alloc(Init%OutData_SrvD%LinNames_y,y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%Names_y ) + if (allocated(Init%OutData_SrvD%LinNames_u)) call move_alloc(Init%OutData_SrvD%LinNames_u,y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%Names_u ) + if (allocated(Init%OutData_SrvD%RotFrame_y)) call move_alloc(Init%OutData_SrvD%RotFrame_y,y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%RotFrame_y ) + if (allocated(Init%OutData_SrvD%RotFrame_u)) call move_alloc(Init%OutData_SrvD%RotFrame_u,y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%RotFrame_u ) + if (allocated(Init%OutData_SrvD%IsLoad_u )) call move_alloc(Init%OutData_SrvD%IsLoad_u ,y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%IsLoad_u ) - if (allocated(InitOutData_SrvD%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%NumOutputs = size(InitOutData_SrvD%WriteOutputHdr) + if (allocated(Init%OutData_SrvD%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_SrvD)%Instance(1)%NumOutputs = size(Init%OutData_SrvD%WriteOutputHdr) end if IF (ErrStat >= AbortErrLev) THEN @@ -755,7 +727,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! ........................ ! bjj: this is a hack to get high-speed shaft braking in FAST v8 - IF ( InitOutData_SrvD%UseHSSBrake ) THEN + IF ( Init%OutData_SrvD%UseHSSBrake ) THEN IF ( p_FAST%CompAero == Module_AD14 ) THEN IF ( AD14%p%DYNINFL ) THEN CALL SetErrStat(ErrID_Fatal,'AeroDyn v14 "DYNINFL" InfModel is invalid for models with high-speed shaft braking.',ErrStat,ErrMsg,RoutineName) @@ -766,7 +738,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, IF ( ED%p%method == Method_RK4 ) THEN ! bjj: should be using ElastoDyn's Method_ABM4 Method_AB4 parameters CALL SetErrStat(ErrID_Fatal,'ElastoDyn must use the AB4 or ABM4 integration method to implement high-speed shaft braking.',ErrStat,ErrMsg,RoutineName) ENDIF - END IF ! InitOutData_SrvD%UseHSSBrake + END IF ! Init%OutData_SrvD%UseHSSBrake END IF @@ -777,7 +749,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! get wave elevation data for visualization if ( p_FAST%WrVTK > VTK_None ) then - call SetVTKParameters_B4HD(p_FAST, InitOutData_ED, InitInData_HD, BD, ErrStat2, ErrMsg2) + call SetVTKParameters_B4HD(p_FAST, Init%OutData_ED, Init%InData_HD, BD, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF (ErrStat >= AbortErrLev) THEN CALL Cleanup() @@ -798,20 +770,20 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, IF ( p_FAST%CompHydro == Module_HD ) THEN - InitInData_HD%Gravity = InitOutData_ED%Gravity - InitInData_HD%UseInputFile = .TRUE. - InitInData_HD%InputFile = p_FAST%HydroFile - InitInData_HD%OutRootName = p_FAST%OutFileRoot - InitInData_HD%TMax = p_FAST%TMax - InitInData_HD%hasIce = p_FAST%CompIce /= Module_None - InitInData_HD%Linearize = p_FAST%Linearize + Init%InData_HD%Gravity = Init%OutData_ED%Gravity + Init%InData_HD%UseInputFile = .TRUE. + Init%InData_HD%InputFile = p_FAST%HydroFile + Init%InData_HD%OutRootName = p_FAST%OutFileRoot + Init%InData_HD%TMax = p_FAST%TMax + Init%InData_HD%hasIce = p_FAST%CompIce /= Module_None + Init%InData_HD%Linearize = p_FAST%Linearize ! if wave field needs an offset, modify these values (added at request of SOWFA developers): - InitInData_HD%PtfmLocationX = p_FAST%TurbinePos(1) - InitInData_HD%PtfmLocationY = p_FAST%TurbinePos(2) + Init%InData_HD%PtfmLocationX = p_FAST%TurbinePos(1) + Init%InData_HD%PtfmLocationY = p_FAST%TurbinePos(2) - CALL HydroDyn_Init( InitInData_HD, HD%Input(1), HD%p, HD%x(STATE_CURR), HD%xd(STATE_CURR), HD%z(STATE_CURR), & - HD%OtherSt(STATE_CURR), HD%y, HD%m, p_FAST%dt_module( MODULE_HD ), InitOutData_HD, ErrStat2, ErrMsg2 ) + CALL HydroDyn_Init( Init%InData_HD, HD%Input(1), HD%p, HD%x(STATE_CURR), HD%xd(STATE_CURR), HD%z(STATE_CURR), & + HD%OtherSt(STATE_CURR), HD%y, HD%m, p_FAST%dt_module( MODULE_HD ), Init%OutData_HD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) p_FAST%ModuleInitialized(Module_HD) = .TRUE. @@ -822,16 +794,16 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, if (ErrStat2 /= 0 ) then call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(HD).", ErrStat, ErrMsg, RoutineName ) else - if (allocated(InitOutData_HD%LinNames_y)) call move_alloc(InitOutData_HD%LinNames_y,y_FAST%Lin%Modules(MODULE_HD)%Instance(1)%Names_y ) - if (allocated(InitOutData_HD%LinNames_u)) call move_alloc(InitOutData_HD%LinNames_u,y_FAST%Lin%Modules(MODULE_HD)%Instance(1)%Names_u ) - if (allocated(InitOutData_HD%LinNames_x)) call move_alloc(InitOutData_HD%LinNames_x, y_FAST%Lin%Modules(MODULE_HD)%Instance(1)%Names_x ) + if (allocated(Init%OutData_HD%LinNames_y)) call move_alloc(Init%OutData_HD%LinNames_y,y_FAST%Lin%Modules(MODULE_HD)%Instance(1)%Names_y ) + if (allocated(Init%OutData_HD%LinNames_u)) call move_alloc(Init%OutData_HD%LinNames_u,y_FAST%Lin%Modules(MODULE_HD)%Instance(1)%Names_u ) + if (allocated(Init%OutData_HD%LinNames_x)) call move_alloc(Init%OutData_HD%LinNames_x, y_FAST%Lin%Modules(MODULE_HD)%Instance(1)%Names_x ) ! LIN-TODO: Determine if we need to create this data even though we don't have rotating frames in HD - !if (allocated(InitOutData_HD%RotFrame_y)) call move_alloc(InitOutData_HD%RotFrame_y,y_FAST%Lin%Modules(MODULE_HD)%Instance(1)%RotFrame_y ) - !if (allocated(InitOutData_HD%RotFrame_u)) call move_alloc(InitOutData_HD%RotFrame_u,y_FAST%Lin%Modules(MODULE_HD)%Instance(1)%RotFrame_u ) - if (allocated(InitOutData_HD%DerivOrder_x)) call move_alloc(InitOutData_HD%DerivOrder_x,y_FAST%Lin%Modules(MODULE_HD)%Instance(1)%DerivOrder_x) - if (allocated(InitOutData_HD%IsLoad_u )) call move_alloc(InitOutData_HD%IsLoad_u ,y_FAST%Lin%Modules(MODULE_HD)%Instance(1)%IsLoad_u ) + !if (allocated(Init%OutData_HD%RotFrame_y)) call move_alloc(Init%OutData_HD%RotFrame_y,y_FAST%Lin%Modules(MODULE_HD)%Instance(1)%RotFrame_y ) + !if (allocated(Init%OutData_HD%RotFrame_u)) call move_alloc(Init%OutData_HD%RotFrame_u,y_FAST%Lin%Modules(MODULE_HD)%Instance(1)%RotFrame_u ) + if (allocated(Init%OutData_HD%DerivOrder_x)) call move_alloc(Init%OutData_HD%DerivOrder_x,y_FAST%Lin%Modules(MODULE_HD)%Instance(1)%DerivOrder_x) + if (allocated(Init%OutData_HD%IsLoad_u )) call move_alloc(Init%OutData_HD%IsLoad_u ,y_FAST%Lin%Modules(MODULE_HD)%Instance(1)%IsLoad_u ) - if (allocated(InitOutData_HD%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_HD)%Instance(1)%NumOutputs = size(InitOutData_HD%WriteOutputHdr) + if (allocated(Init%OutData_HD%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_HD)%Instance(1)%NumOutputs = size(Init%OutData_HD%WriteOutputHdr) end if IF (ErrStat >= AbortErrLev) THEN @@ -860,21 +832,21 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, IF ( p_FAST%CompSub == Module_SD ) THEN IF ( p_FAST%CompHydro == Module_HD ) THEN - InitInData_SD%WtrDpth = InitOutData_HD%WtrDpth + Init%InData_SD%WtrDpth = Init%OutData_HD%WtrDpth ELSE - InitInData_SD%WtrDpth = 0.0_ReKi + Init%InData_SD%WtrDpth = 0.0_ReKi END IF - InitInData_SD%g = InitOutData_ED%Gravity - !InitInData_SD%UseInputFile = .TRUE. - InitInData_SD%SDInputFile = p_FAST%SubFile - InitInData_SD%RootName = p_FAST%OutFileRoot - InitInData_SD%TP_RefPoint = ED%Output(1)%PlatformPtMesh%Position(:,1) ! bjj: not sure what this is supposed to be - InitInData_SD%SubRotateZ = 0.0 ! bjj: not sure what this is supposed to be + Init%InData_SD%g = Init%OutData_ED%Gravity + !Init%InData_SD%UseInputFile = .TRUE. + Init%InData_SD%SDInputFile = p_FAST%SubFile + Init%InData_SD%RootName = p_FAST%OutFileRoot + Init%InData_SD%TP_RefPoint = ED%y%PlatformPtMesh%Position(:,1) ! bjj: not sure what this is supposed to be + Init%InData_SD%SubRotateZ = 0.0 ! bjj: not sure what this is supposed to be - CALL SD_Init( InitInData_SD, SD%Input(1), SD%p, SD%x(STATE_CURR), SD%xd(STATE_CURR), SD%z(STATE_CURR), & - SD%OtherSt(STATE_CURR), SD%y, SD%m, p_FAST%dt_module( MODULE_SD ), InitOutData_SD, ErrStat2, ErrMsg2 ) + CALL SD_Init( Init%InData_SD, SD%Input(1), SD%p, SD%x(STATE_CURR), SD%xd(STATE_CURR), SD%z(STATE_CURR), & + SD%OtherSt(STATE_CURR), SD%y, SD%m, p_FAST%dt_module( MODULE_SD ), Init%OutData_SD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) p_FAST%ModuleInitialized(Module_SD) = .TRUE. @@ -887,14 +859,14 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, END IF ELSE IF ( p_FAST%CompSub == Module_ExtPtfm ) THEN - InitInData_ExtPtfm%InputFile = p_FAST%SubFile - InitInData_ExtPtfm%RootName = trim(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_ExtPtfm)) - InitInData_ExtPtfm%Linearize = p_FAST%Linearize - InitInData_ExtPtfm%PtfmRefzt = ED%p%PtfmRefzt ! Required + Init%InData_ExtPtfm%InputFile = p_FAST%SubFile + Init%InData_ExtPtfm%RootName = trim(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_ExtPtfm)) + Init%InData_ExtPtfm%Linearize = p_FAST%Linearize + Init%InData_ExtPtfm%PtfmRefzt = ED%p%PtfmRefzt ! Required - CALL ExtPtfm_Init( InitInData_ExtPtfm, ExtPtfm%Input(1), ExtPtfm%p, & + CALL ExtPtfm_Init( Init%InData_ExtPtfm, ExtPtfm%Input(1), ExtPtfm%p, & ExtPtfm%x(STATE_CURR), ExtPtfm%xd(STATE_CURR), ExtPtfm%z(STATE_CURR), ExtPtfm%OtherSt(STATE_CURR), & - ExtPtfm%y, ExtPtfm%m, p_FAST%dt_module( MODULE_ExtPtfm ), InitOutData_ExtPtfm, ErrStat2, ErrMsg2 ) + ExtPtfm%y, ExtPtfm%m, p_FAST%dt_module( MODULE_ExtPtfm ), Init%OutData_ExtPtfm, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) p_FAST%ModuleInitialized(MODULE_ExtPtfm) = .TRUE. @@ -905,14 +877,14 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, if (ErrStat2 /= 0 ) then call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(ExtPtfm).", ErrStat, ErrMsg, RoutineName ) else - if (allocated(InitOutData_ExtPtfm%LinNames_y)) call move_alloc(InitOutData_ExtPtfm%LinNames_y,y_FAST%Lin%Modules(MODULE_ExtPtfm)%Instance(1)%Names_y) - if (allocated(InitOutData_ExtPtfm%LinNames_x)) call move_alloc(InitOutData_ExtPtfm%LinNames_x,y_FAST%Lin%Modules(MODULE_ExtPtfm)%Instance(1)%Names_x) - if (allocated(InitOutData_ExtPtfm%LinNames_u)) call move_alloc(InitOutData_ExtPtfm%LinNames_u,y_FAST%Lin%Modules(MODULE_ExtPtfm)%Instance(1)%Names_u) - if (allocated(InitOutData_ExtPtfm%RotFrame_y)) call move_alloc(InitOutData_ExtPtfm%RotFrame_y,y_FAST%Lin%Modules(MODULE_ExtPtfm)%Instance(1)%RotFrame_y) - if (allocated(InitOutData_ExtPtfm%RotFrame_x)) call move_alloc(InitOutData_ExtPtfm%RotFrame_x,y_FAST%Lin%Modules(MODULE_ExtPtfm)%Instance(1)%RotFrame_x) - if (allocated(InitOutData_ExtPtfm%RotFrame_u)) call move_alloc(InitOutData_ExtPtfm%RotFrame_u,y_FAST%Lin%Modules(MODULE_ExtPtfm)%Instance(1)%RotFrame_u) - if (allocated(InitOutData_ExtPtfm%IsLoad_u )) call move_alloc(InitOutData_ExtPtfm%IsLoad_u ,y_FAST%Lin%Modules(MODULE_ExtPtfm)%Instance(1)%IsLoad_u ) - if (allocated(InitOutData_ExtPtfm%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_ExtPtfm)%Instance(1)%NumOutputs = size(InitOutData_ExtPtfm%WriteOutputHdr) + if (allocated(Init%OutData_ExtPtfm%LinNames_y)) call move_alloc(Init%OutData_ExtPtfm%LinNames_y,y_FAST%Lin%Modules(MODULE_ExtPtfm)%Instance(1)%Names_y) + if (allocated(Init%OutData_ExtPtfm%LinNames_x)) call move_alloc(Init%OutData_ExtPtfm%LinNames_x,y_FAST%Lin%Modules(MODULE_ExtPtfm)%Instance(1)%Names_x) + if (allocated(Init%OutData_ExtPtfm%LinNames_u)) call move_alloc(Init%OutData_ExtPtfm%LinNames_u,y_FAST%Lin%Modules(MODULE_ExtPtfm)%Instance(1)%Names_u) + if (allocated(Init%OutData_ExtPtfm%RotFrame_y)) call move_alloc(Init%OutData_ExtPtfm%RotFrame_y,y_FAST%Lin%Modules(MODULE_ExtPtfm)%Instance(1)%RotFrame_y) + if (allocated(Init%OutData_ExtPtfm%RotFrame_x)) call move_alloc(Init%OutData_ExtPtfm%RotFrame_x,y_FAST%Lin%Modules(MODULE_ExtPtfm)%Instance(1)%RotFrame_x) + if (allocated(Init%OutData_ExtPtfm%RotFrame_u)) call move_alloc(Init%OutData_ExtPtfm%RotFrame_u,y_FAST%Lin%Modules(MODULE_ExtPtfm)%Instance(1)%RotFrame_u) + if (allocated(Init%OutData_ExtPtfm%IsLoad_u )) call move_alloc(Init%OutData_ExtPtfm%IsLoad_u ,y_FAST%Lin%Modules(MODULE_ExtPtfm)%Instance(1)%IsLoad_u ) + if (allocated(Init%OutData_ExtPtfm%WriteOutputHdr)) y_FAST%Lin%Modules(MODULE_ExtPtfm)%Instance(1)%NumOutputs = size(Init%OutData_ExtPtfm%WriteOutputHdr) end if IF (ErrStat >= AbortErrLev) THEN @@ -959,20 +931,20 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, CALL WrScr(NewLine) !bjj: I'm printing two blank lines here because MAP seems to be writing over the last line on the screen. -! InitInData_MAP%rootname = p_FAST%OutFileRoot ! Output file name - InitInData_MAP%gravity = InitOutData_ED%Gravity ! This need to be according to g used in ElastoDyn - InitInData_MAP%sea_density = InitOutData_HD%WtrDens ! This needs to be set according to seawater density in HydroDyn - InitInData_MAP%depth = InitOutData_HD%WtrDpth ! This need to be set according to the water depth in HydroDyn +! Init%InData_MAP%rootname = p_FAST%OutFileRoot ! Output file name + Init%InData_MAP%gravity = Init%OutData_ED%Gravity ! This need to be according to g used in ElastoDyn + Init%InData_MAP%sea_density = Init%OutData_HD%WtrDens ! This needs to be set according to seawater density in HydroDyn + Init%InData_MAP%depth = Init%OutData_HD%WtrDpth ! This need to be set according to the water depth in HydroDyn ! differences for MAP++ - InitInData_MAP%file_name = p_FAST%MooringFile ! This needs to be set according to what is in the FAST input file. - InitInData_MAP%summary_file_name = TRIM(p_FAST%OutFileRoot)//'.MAP.sum' ! Output file name - InitInData_MAP%depth = -InitOutData_HD%WtrDpth ! This need to be set according to the water depth in HydroDyn + Init%InData_MAP%file_name = p_FAST%MooringFile ! This needs to be set according to what is in the FAST input file. + Init%InData_MAP%summary_file_name = TRIM(p_FAST%OutFileRoot)//'.MAP.sum' ! Output file name + Init%InData_MAP%depth = -Init%OutData_HD%WtrDpth ! This need to be set according to the water depth in HydroDyn - InitInData_MAP%LinInitInp%Linearize = p_FAST%Linearize + Init%InData_MAP%LinInitInp%Linearize = p_FAST%Linearize - CALL MAP_Init( InitInData_MAP, MAPp%Input(1), MAPp%p, MAPp%x(STATE_CURR), MAPp%xd(STATE_CURR), MAPp%z(STATE_CURR), MAPp%OtherSt, & - MAPp%y, p_FAST%dt_module( MODULE_MAP ), InitOutData_MAP, ErrStat2, ErrMsg2 ) + CALL MAP_Init( Init%InData_MAP, MAPp%Input(1), MAPp%p, MAPp%x(STATE_CURR), MAPp%xd(STATE_CURR), MAPp%z(STATE_CURR), MAPp%OtherSt, & + MAPp%y, p_FAST%dt_module( MODULE_MAP ), Init%OutData_MAP, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) p_FAST%ModuleInitialized(Module_MAP) = .TRUE. @@ -983,14 +955,14 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, if (ErrStat2 /= 0 ) then call SetErrStat(ErrID_Fatal, "Error allocating Lin%Modules(MAP).", ErrStat, ErrMsg, RoutineName ) else - if (allocated(InitOutData_MAP%LinInitOut%LinNames_y)) call move_alloc(InitOutData_MAP%LinInitOut%LinNames_y,y_FAST%Lin%Modules(Module_MAP)%Instance(1)%Names_y ) - if (allocated(InitOutData_MAP%LinInitOut%LinNames_u)) call move_alloc(InitOutData_MAP%LinInitOut%LinNames_u,y_FAST%Lin%Modules(Module_MAP)%Instance(1)%Names_u ) + if (allocated(Init%OutData_MAP%LinInitOut%LinNames_y)) call move_alloc(Init%OutData_MAP%LinInitOut%LinNames_y,y_FAST%Lin%Modules(Module_MAP)%Instance(1)%Names_y ) + if (allocated(Init%OutData_MAP%LinInitOut%LinNames_u)) call move_alloc(Init%OutData_MAP%LinInitOut%LinNames_u,y_FAST%Lin%Modules(Module_MAP)%Instance(1)%Names_u ) ! LIN-TODO: Determine if we need to create this data even though we don't have rotating frames in MAP - !if (allocated(InitOutData_MAP%LinInitOut%RotFrame_y)) call move_alloc(InitOutData_MAP%LinInitOut%RotFrame_y,y_FAST%Lin%Modules(Module_MAP)%Instance(1)%RotFrame_y ) - !if (allocated(InitOutData_MAP%LinInitOut%RotFrame_u)) call move_alloc(InitOutData_MAP%LinInitOut%RotFrame_u,y_FAST%Lin%Modules(Module_MAP)%Instance(1)%RotFrame_u ) - if (allocated(InitOutData_MAP%LinInitOut%IsLoad_u )) call move_alloc(InitOutData_MAP%LinInitOut%IsLoad_u ,y_FAST%Lin%Modules(Module_MAP)%Instance(1)%IsLoad_u ) + !if (allocated(Init%OutData_MAP%LinInitOut%RotFrame_y)) call move_alloc(Init%OutData_MAP%LinInitOut%RotFrame_y,y_FAST%Lin%Modules(Module_MAP)%Instance(1)%RotFrame_y ) + !if (allocated(Init%OutData_MAP%LinInitOut%RotFrame_u)) call move_alloc(Init%OutData_MAP%LinInitOut%RotFrame_u,y_FAST%Lin%Modules(Module_MAP)%Instance(1)%RotFrame_u ) + if (allocated(Init%OutData_MAP%LinInitOut%IsLoad_u )) call move_alloc(Init%OutData_MAP%LinInitOut%IsLoad_u ,y_FAST%Lin%Modules(Module_MAP)%Instance(1)%IsLoad_u ) - if (allocated(InitOutData_MAP%WriteOutputHdr)) y_FAST%Lin%Modules(Module_MAP)%Instance(1)%NumOutputs = size(InitOutData_MAP%WriteOutputHdr) + if (allocated(Init%OutData_MAP%WriteOutputHdr)) y_FAST%Lin%Modules(Module_MAP)%Instance(1)%NumOutputs = size(Init%OutData_MAP%WriteOutputHdr) end if IF (ErrStat >= AbortErrLev) THEN @@ -1002,16 +974,16 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! ........................ ELSEIF (p_FAST%CompMooring == Module_MD) THEN - InitInData_MD%FileName = p_FAST%MooringFile ! This needs to be set according to what is in the FAST input file. - InitInData_MD%RootName = p_FAST%OutFileRoot + Init%InData_MD%FileName = p_FAST%MooringFile ! This needs to be set according to what is in the FAST input file. + Init%InData_MD%RootName = p_FAST%OutFileRoot - InitInData_MD%PtfmInit = InitOutData_ED%PlatformPos !ED%x(STATE_CURR)%QT(1:6) ! initial position of the platform !bjj: this should come from InitOutData_ED, not x_ED - InitInData_MD%g = InitOutData_ED%Gravity ! This need to be according to g used in ElastoDyn - InitInData_MD%rhoW = InitOutData_HD%WtrDens ! This needs to be set according to seawater density in HydroDyn - InitInData_MD%WtrDepth = InitOutData_HD%WtrDpth ! This need to be set according to the water depth in HydroDyn + Init%InData_MD%PtfmInit = Init%OutData_ED%PlatformPos !ED%x(STATE_CURR)%QT(1:6) ! initial position of the platform !bjj: this should come from Init%OutData_ED, not x_ED + Init%InData_MD%g = Init%OutData_ED%Gravity ! This need to be according to g used in ElastoDyn + Init%InData_MD%rhoW = Init%OutData_HD%WtrDens ! This needs to be set according to seawater density in HydroDyn + Init%InData_MD%WtrDepth = Init%OutData_HD%WtrDpth ! This need to be set according to the water depth in HydroDyn - CALL MD_Init( InitInData_MD, MD%Input(1), MD%p, MD%x(STATE_CURR), MD%xd(STATE_CURR), MD%z(STATE_CURR), & - MD%OtherSt(STATE_CURR), MD%y, MD%m, p_FAST%dt_module( MODULE_MD ), InitOutData_MD, ErrStat2, ErrMsg2 ) + CALL MD_Init( Init%InData_MD, MD%Input(1), MD%p, MD%x(STATE_CURR), MD%xd(STATE_CURR), MD%z(STATE_CURR), & + MD%OtherSt(STATE_CURR), MD%y, MD%m, p_FAST%dt_module( MODULE_MD ), Init%OutData_MD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) p_FAST%ModuleInitialized(Module_MD) = .TRUE. @@ -1027,17 +999,17 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! ........................ ELSEIF (p_FAST%CompMooring == Module_FEAM) THEN - InitInData_FEAM%InputFile = p_FAST%MooringFile ! This needs to be set according to what is in the FAST input file. - InitInData_FEAM%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_FEAM)) - - InitInData_FEAM%PtfmInit = InitOutData_ED%PlatformPos !ED%x(STATE_CURR)%QT(1:6) ! initial position of the platform !bjj: this should come from InitOutData_ED, not x_ED - InitInData_FEAM%NStepWave = 1 ! an arbitrary number > 0 (to set the size of the wave data, which currently contains all zero values) - InitInData_FEAM%gravity = InitOutData_ED%Gravity ! This need to be according to g used in ElastoDyn - InitInData_FEAM%WtrDens = InitOutData_HD%WtrDens ! This needs to be set according to seawater density in HydroDyn -! InitInData_FEAM%depth = InitOutData_HD%WtrDpth ! This need to be set according to the water depth in HydroDyn + Init%InData_FEAM%InputFile = p_FAST%MooringFile ! This needs to be set according to what is in the FAST input file. + Init%InData_FEAM%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_FEAM)) + + Init%InData_FEAM%PtfmInit = Init%OutData_ED%PlatformPos !ED%x(STATE_CURR)%QT(1:6) ! initial position of the platform !bjj: this should come from Init%OutData_ED, not x_ED + Init%InData_FEAM%NStepWave = 1 ! an arbitrary number > 0 (to set the size of the wave data, which currently contains all zero values) + Init%InData_FEAM%gravity = Init%OutData_ED%Gravity ! This need to be according to g used in ElastoDyn + Init%InData_FEAM%WtrDens = Init%OutData_HD%WtrDens ! This needs to be set according to seawater density in HydroDyn +! Init%InData_FEAM%depth = Init%OutData_HD%WtrDpth ! This need to be set according to the water depth in HydroDyn - CALL FEAM_Init( InitInData_FEAM, FEAM%Input(1), FEAM%p, FEAM%x(STATE_CURR), FEAM%xd(STATE_CURR), FEAM%z(STATE_CURR), & - FEAM%OtherSt(STATE_CURR), FEAM%y, FEAM%m, p_FAST%dt_module( MODULE_FEAM ), InitOutData_FEAM, ErrStat2, ErrMsg2 ) + CALL FEAM_Init( Init%InData_FEAM, FEAM%Input(1), FEAM%p, FEAM%x(STATE_CURR), FEAM%xd(STATE_CURR), FEAM%z(STATE_CURR), & + FEAM%OtherSt(STATE_CURR), FEAM%y, FEAM%m, p_FAST%dt_module( MODULE_FEAM ), Init%OutData_FEAM, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) p_FAST%ModuleInitialized(Module_FEAM) = .TRUE. @@ -1053,12 +1025,12 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! ........................ ELSEIF (p_FAST%CompMooring == Module_Orca) THEN - InitInData_Orca%InputFile = p_FAST%MooringFile - InitInData_Orca%RootName = p_FAST%OutFileRoot - InitInData_Orca%TMax = p_FAST%TMax + Init%InData_Orca%InputFile = p_FAST%MooringFile + Init%InData_Orca%RootName = p_FAST%OutFileRoot + Init%InData_Orca%TMax = p_FAST%TMax - CALL Orca_Init( InitInData_Orca, Orca%Input(1), Orca%p, Orca%x(STATE_CURR), Orca%xd(STATE_CURR), Orca%z(STATE_CURR), Orca%OtherSt(STATE_CURR), & - Orca%y, Orca%m, p_FAST%dt_module( MODULE_Orca ), InitOutData_Orca, ErrStat2, ErrMsg2 ) + CALL Orca_Init( Init%InData_Orca, Orca%Input(1), Orca%p, Orca%x(STATE_CURR), Orca%xd(STATE_CURR), Orca%z(STATE_CURR), Orca%OtherSt(STATE_CURR), & + Orca%y, Orca%m, p_FAST%dt_module( MODULE_Orca ), Init%OutData_Orca, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) p_FAST%ModuleInitialized(MODULE_Orca) = .TRUE. @@ -1119,14 +1091,14 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! ........................ IF ( p_FAST%CompIce == Module_IceF ) THEN - InitInData_IceF%InputFile = p_FAST%IceFile - InitInData_IceF%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_IceF)) - InitInData_IceF%simLength = p_FAST%TMax !bjj: IceFloe stores this as single-precision (ReKi) TMax is DbKi - InitInData_IceF%MSL2SWL = InitOutData_HD%MSL2SWL - InitInData_IceF%gravity = InitOutData_ED%Gravity - - CALL IceFloe_Init( InitInData_IceF, IceF%Input(1), IceF%p, IceF%x(STATE_CURR), IceF%xd(STATE_CURR), IceF%z(STATE_CURR), & - IceF%OtherSt(STATE_CURR), IceF%y, IceF%m, p_FAST%dt_module( MODULE_IceF ), InitOutData_IceF, ErrStat2, ErrMsg2 ) + Init%InData_IceF%InputFile = p_FAST%IceFile + Init%InData_IceF%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_IceF)) + Init%InData_IceF%simLength = p_FAST%TMax !bjj: IceFloe stores this as single-precision (ReKi) TMax is DbKi + Init%InData_IceF%MSL2SWL = Init%OutData_HD%MSL2SWL + Init%InData_IceF%gravity = Init%OutData_ED%Gravity + + CALL IceFloe_Init( Init%InData_IceF, IceF%Input(1), IceF%p, IceF%x(STATE_CURR), IceF%xd(STATE_CURR), IceF%z(STATE_CURR), & + IceF%OtherSt(STATE_CURR), IceF%y, IceF%m, p_FAST%dt_module( MODULE_IceF ), Init%OutData_IceF, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) p_FAST%ModuleInitialized(Module_IceF) = .TRUE. @@ -1142,16 +1114,16 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! ........................ ELSEIF ( p_FAST%CompIce == Module_IceD ) THEN - InitInData_IceD%InputFile = p_FAST%IceFile - InitInData_IceD%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_IceD))//'1' - InitInData_IceD%MSL2SWL = InitOutData_HD%MSL2SWL - InitInData_IceD%WtrDens = InitOutData_HD%WtrDens - InitInData_IceD%gravity = InitOutData_ED%Gravity - InitInData_IceD%TMax = p_FAST%TMax - InitInData_IceD%LegNum = 1 + Init%InData_IceD%InputFile = p_FAST%IceFile + Init%InData_IceD%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_IceD))//'1' + Init%InData_IceD%MSL2SWL = Init%OutData_HD%MSL2SWL + Init%InData_IceD%WtrDens = Init%OutData_HD%WtrDens + Init%InData_IceD%gravity = Init%OutData_ED%Gravity + Init%InData_IceD%TMax = p_FAST%TMax + Init%InData_IceD%LegNum = 1 - CALL IceD_Init( InitInData_IceD, IceD%Input(1,1), IceD%p(1), IceD%x(1,STATE_CURR), IceD%xd(1,STATE_CURR), IceD%z(1,STATE_CURR), & - IceD%OtherSt(1,STATE_CURR), IceD%y(1), IceD%m(1), p_FAST%dt_module( MODULE_IceD ), InitOutData_IceD, ErrStat2, ErrMsg2 ) + CALL IceD_Init( Init%InData_IceD, IceD%Input(1,1), IceD%p(1), IceD%x(1,STATE_CURR), IceD%xd(1,STATE_CURR), IceD%z(1,STATE_CURR), & + IceD%OtherSt(1,STATE_CURR), IceD%y(1), IceD%m(1), p_FAST%dt_module( MODULE_IceD ), Init%OutData_IceD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) p_FAST%ModuleInitialized(Module_IceD) = .TRUE. @@ -1160,7 +1132,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! now initialize IceD for additional legs (if necessary) dt_IceD = p_FAST%dt_module( MODULE_IceD ) - p_FAST%numIceLegs = InitOutData_IceD%numLegs + p_FAST%numIceLegs = Init%OutData_IceD%numLegs IF (p_FAST%numIceLegs > IceD_MaxLegs) THEN CALL SetErrStat(ErrID_Fatal,'IceDyn-FAST coupling is supported for up to '//TRIM(Num2LStr(IceD_MaxLegs))//' legs, but ' & @@ -1169,11 +1141,11 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, DO i=2,p_FAST%numIceLegs ! basically, we just need IceDyn to set up its meshes for inputs/outputs and possibly initial values for states - InitInData_IceD%LegNum = i - InitInData_IceD%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_IceD))//TRIM(Num2LStr(i)) + Init%InData_IceD%LegNum = i + Init%InData_IceD%RootName = TRIM(p_FAST%OutFileRoot)//'.'//TRIM(y_FAST%Module_Abrev(Module_IceD))//TRIM(Num2LStr(i)) - CALL IceD_Init( InitInData_IceD, IceD%Input(1,i), IceD%p(i), IceD%x(i,STATE_CURR), IceD%xd(i,STATE_CURR), IceD%z(i,STATE_CURR), & - IceD%OtherSt(i,STATE_CURR), IceD%y(i), IceD%m(i), dt_IceD, InitOutData_IceD, ErrStat2, ErrMsg2 ) + CALL IceD_Init( Init%InData_IceD, IceD%Input(1,i), IceD%p(i), IceD%x(i,STATE_CURR), IceD%xd(i,STATE_CURR), IceD%z(i,STATE_CURR), & + IceD%OtherSt(i,STATE_CURR), IceD%y(i), IceD%m(i), dt_IceD, Init%OutData_IceD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) !bjj: we're going to force this to have the same timestep because I don't want to have to deal with n IceD modules with n timesteps. @@ -1194,9 +1166,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! Set up output for glue code (must be done after all modules are initialized so we have their WriteOutput information) ! ........................ - CALL FAST_InitOutput( p_FAST, y_FAST, InitOutData_ED, InitOutData_BD, InitOutData_SrvD, InitOutData_AD14, InitOutData_AD, & - InitOutData_IfW, InitOutData_OpFM, InitOutData_HD, InitOutData_SD, InitOutData_ExtPtfm, InitOutData_MAP, & - InitOutData_FEAM, InitOutData_MD, InitOutData_Orca, InitOutData_IceF, InitOutData_IceD, ErrStat2, ErrMsg2 ) + CALL FAST_InitOutput( p_FAST, y_FAST, Init, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) @@ -1210,13 +1180,18 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, IF (ErrStat >= AbortErrLev) THEN CALL Cleanup() RETURN - END IF + ELSEIF (ErrStat /= ErrID_None) THEN + ! a little work-around in case the mesh mapping info messages get too long + CALL WrScr( NewLine//TRIM(ErrMsg)//NewLine ) + ErrStat = ErrID_None + ErrMsg = "" + END IF ! ------------------------------------------------------------------------- ! Initialize for linearization: ! ------------------------------------------------------------------------- if ( p_FAST%Linearize ) then - call Init_Lin(p_FAST, y_FAST, m_FAST, AD, InitOutData_ED%NumBl, ErrStat2, ErrMsg2) + call Init_Lin(p_FAST, y_FAST, m_FAST, AD, ED, Init%OutData_ED%NumBl, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) if (ErrStat >= AbortErrLev) then @@ -1230,7 +1205,7 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! Initialize data for VTK output ! ------------------------------------------------------------------------- if ( p_FAST%WrVTK > VTK_None ) then - call SetVTKParameters(p_FAST, InitOutData_ED, InitOutData_AD, InitInData_HD, InitOutData_HD, ED, BD, AD, HD, ErrStat2, ErrMsg2) + call SetVTKParameters(p_FAST, Init%OutData_ED, Init%OutData_AD, Init%InData_HD, Init%OutData_HD, ED, BD, AD, HD, ErrStat2, ErrMsg2) call SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) end if @@ -1248,7 +1223,6 @@ SUBROUTINE FAST_InitializeAll( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, ! ------------------------------------------------------------------------- m_FAST%t_global = t_initial - m_FAST%NextLinTimeIndx = 1 ! Initialize external inputs for first step if ( p_FAST%CompServo == MODULE_SrvD ) then @@ -1276,91 +1250,8 @@ SUBROUTINE Cleanup() !............................................................................................................................... ! Destroy initializion data !............................................................................................................................... - - CALL ED_DestroyInitInput( InitInData_ED, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL ED_DestroyInitOutput( InitOutData_ED, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - CALL BD_DestroyInitInput( InitInData_BD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - IF (ALLOCATED(InitOutData_BD)) THEN - DO i=1,p_FAST%nBeams - CALL BD_DestroyInitOutput( InitOutData_BD(i), ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - END DO - DEALLOCATE(InitOutData_BD) - END IF - - CALL AD14_DestroyInitInput( InitInData_AD14, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL AD14_DestroyInitOutput( InitOutData_AD14, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - CALL AD_DestroyInitInput( InitInData_AD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL AD_DestroyInitOutput( InitOutData_AD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - CALL InflowWind_DestroyInitInput( InitInData_IfW, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL InflowWind_DestroyInitOutput( InitOutData_IfW, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - CALL OpFM_DestroyInitInput( InitInData_OpFM, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL OpFM_DestroyInitOutput( InitOutData_OpFM, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - CALL SrvD_DestroyInitInput( InitInData_SrvD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL SrvD_DestroyInitOutput( InitOutData_SrvD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - CALL HydroDyn_DestroyInitInput( InitInData_HD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL HydroDyn_DestroyInitOutput( InitOutData_HD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - CALL SD_DestroyInitInput( InitInData_SD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL SD_DestroyInitOutput( InitOutData_SD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - CALL ExtPtfm_DestroyInitInput( InitInData_ExtPtfm, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL ExtPtfm_DestroyInitOutput( InitOutData_ExtPtfm, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - CALL MAP_DestroyInitInput( InitInData_MAP, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL MAP_DestroyInitOutput( InitOutData_MAP, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - CALL FEAM_DestroyInitInput( InitInData_FEAM, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL FEAM_DestroyInitOutput( InitOutData_FEAM, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - CALL MD_DestroyInitInput( InitInData_MD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL MD_DestroyInitOutput( InitOutData_MD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - CALL Orca_DestroyInitInput( InitInData_Orca, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL Orca_DestroyInitOutput( InitOutData_Orca, ErrStat2, ErrMsg2 ) + CALL FAST_DestroyInitData( Init, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - CALL IceFloe_DestroyInitInput( InitInData_IceF, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL IceFloe_DestroyInitOutput( InitOutData_IceF, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - - CALL IceD_DestroyInitInput( InitInData_IceD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) - CALL IceD_DestroyInitOutput( InitOutData_IceD, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) END SUBROUTINE Cleanup @@ -1460,13 +1351,14 @@ END SUBROUTINE GetInputFileName !---------------------------------------------------------------------------------------------------------------------------------- !> This subroutine checks for command-line arguments, gets the root name of the input files !! (including full path name), and creates the names of the output files. -SUBROUTINE FAST_Init( p, y_FAST, t_initial, InputFile, ErrStat, ErrMsg, TMax, TurbID, OverrideAbortLev, RootName ) +SUBROUTINE FAST_Init( p, m_FAST, y_FAST, t_initial, InputFile, ErrStat, ErrMsg, TMax, TurbID, OverrideAbortLev, RootName ) IMPLICIT NONE ! Passed variables TYPE(FAST_ParameterType), INTENT(INOUT) :: p !< The parameter data for the FAST (glue-code) simulation + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< The output data for the FAST (glue-code) simulation REAL(DbKi), INTENT(IN) :: t_initial !< the beginning time of the simulation INTEGER(IntKi), INTENT(OUT) :: ErrStat !< Error status @@ -1517,6 +1409,7 @@ SUBROUTINE FAST_Init( p, y_FAST, t_initial, InputFile, ErrStat, ErrMsg, TMax, Tu END IF end if + p%VTK_OutFileRoot = p%OutFileRoot !initialize this here in case of error before it is set later !............................................................................................................................... @@ -1567,9 +1460,15 @@ SUBROUTINE FAST_Init( p, y_FAST, t_initial, InputFile, ErrStat, ErrMsg, TMax, Tu !............................................................................................................................... ! Read the primary file for the glue code: !............................................................................................................................... - CALL FAST_ReadPrimaryFile( InputFile, p, OverrideAbortErrLev, ErrStat2, ErrMsg2 ) + CALL FAST_ReadPrimaryFile( InputFile, p, m_FAST, OverrideAbortErrLev, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - + + ! make sure some linearization variables are consistant + if (.not. p%Linearize) p%CalcSteady = .false. + if (.not. p%CalcSteady) p%TrimCase = TrimCase_none + m_FAST%Lin%FoundSteady = .false. + p%LinInterpOrder = p%InterpOrder ! 1 ! always use linear (or constant) interpolation on rotor? + ! overwrite TMax if necessary) IF (PRESENT(TMax)) THEN p%TMax = TMax @@ -1606,16 +1505,16 @@ SUBROUTINE FAST_Init( p, y_FAST, t_initial, InputFile, ErrStat, ErrMsg, TMax, Tu p%n_TMax_m1 = CEILING( ( (p%TMax - t_initial) / p%DT ) ) - 1 ! We're going to go from step 0 to n_TMax (thus the -1 here) if (p%TMax < 1.0_DbKi) then ! log10(0) gives floating point divide-by-zero error - p%TChanLen = 10 + p%TChanLen = MinChanLen else - p%TChanLen = max( 10, int(log10(p%TMax))+7 ) + p%TChanLen = max( MinChanLen, int(log10(p%TMax))+7 ) end if p%OutFmt_t = 'F'//trim(num2lstr( p%TChanLen ))//'.4' ! 'F10.4' !............................................................................................................................... ! Do some error checking on the inputs (validation): !............................................................................................................................... - call ValidateInputData(p, ErrStat2, ErrMsg2) + call ValidateInputData(p, m_FAST, ErrStat2, ErrMsg2) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -1627,9 +1526,10 @@ SUBROUTINE FAST_Init( p, y_FAST, t_initial, InputFile, ErrStat, ErrMsg, TMax, Tu END SUBROUTINE FAST_Init !---------------------------------------------------------------------------------------------------------------------------------- !> This routine validates FAST data. -SUBROUTINE ValidateInputData(p, ErrStat, ErrMsg) +SUBROUTINE ValidateInputData(p, m_FAST, ErrStat, ErrMsg) TYPE(FAST_ParameterType), INTENT(INOUT) :: p !< The parameter data for the FAST (glue-code) simulation + TYPE(FAST_MiscVarType), INTENT(IN ) :: m_FAST !< The misc data for the FAST (glue-code) simulation INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message @@ -1669,11 +1569,11 @@ SUBROUTINE ValidateInputData(p, ErrStat, ErrMsg) CALL ChkRealFmtStr( p%OutFmt, 'OutFmt', p%FmtWidth, ErrStat2, ErrMsg2 ) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF ( p%FmtWidth /= ChanLen ) CALL SetErrStat( ErrID_Warn, 'OutFmt produces a column width of '// & - TRIM(Num2LStr(p%FmtWidth))//' instead of '//TRIM(Num2LStr(ChanLen))//' characters.', ErrStat, ErrMsg, RoutineName ) + IF ( p%WrTxtOutFile .and. p%FmtWidth < MinChanLen ) CALL SetErrStat( ErrID_Warn, 'OutFmt produces a column width of '// & + TRIM(Num2LStr(p%FmtWidth))//'), which may be too small.', ErrStat, ErrMsg, RoutineName ) IF ( p%WrTxtOutFile .AND. p%TChanLen > ChanLen ) THEN ! ( p%TMax > 9999.999_DbKi ) - CALL SetErrStat( ErrID_Warn, 'TMax is too large for a 10-character time column in text tabular (time-marching) output files.'// & + CALL SetErrStat( ErrID_Warn, 'TMax is too large for a '//trim(num2lstr(ChanLen))//'-character time column in text tabular (time-marching) output files.'// & ' Postprocessors with this limitation may not work.', ErrStat, ErrMsg, RoutineName ) END IF @@ -1724,21 +1624,45 @@ SUBROUTINE ValidateInputData(p, ErrStat, ErrMsg) if ( p%WrVTK == VTK_Unknown ) then - call SetErrStat(ErrID_Fatal, 'WrVTK must be 0 (none), 1 (initialization only), or 2 (animation).', ErrStat, ErrMsg, RoutineName) + call SetErrStat(ErrID_Fatal, 'WrVTK must be 0 (none), 1 (initialization only), 2 (animation), or 3 (mode shapes).', ErrStat, ErrMsg, RoutineName) else if ( p%VTK_type == VTK_Unknown ) then call SetErrStat(ErrID_Fatal, 'VTK_type must be 1 (surfaces), 2 (basic meshes:lines/points), or 3 (all meshes).', ErrStat, ErrMsg, RoutineName) ! note I'm not going to write that 4 (old) is an option - end if + end if + + if (p%WrVTK == VTK_ModeShapes .and. .not. p%Linearize) then + call SetErrStat(ErrID_Fatal, 'WrVTK cannot be 3 (mode shapes) when Linearize is false. (Mode shapes require linearization analysis.)', ErrStat, ErrMsg, RoutineName) + end if end if - if (p%Linearize) then - if (p%LinTimes(1) < 0) call SetErrStat(ErrID_Fatal,'LinTimes must be positive values.',ErrStat, ErrMsg, RoutineName) - do i=2,size(p%LinTimes) - if (p%LinTimes(i) < 0) call SetErrStat(ErrID_Fatal,'LinTimes must be positive values.',ErrStat, ErrMsg, RoutineName) - if (p%LinTimes(i) <= p%LinTimes(i-1)) call SetErrStat(ErrID_Fatal,'LinTimes must be unique values entered in increasing order.',ErrStat, ErrMsg, RoutineName) - end do + + if (p%CalcSteady) then + if (p%NLinTimes < 1) call SetErrStat(ErrID_Fatal,'NLinTimes must be at least 1 for linearization analysis.',ErrStat, ErrMsg, RoutineName) + if (p%TrimCase /= TrimCase_yaw .and. p%TrimCase /= TrimCase_torque .and. p%TrimCase /= TrimCase_pitch) then + call SetErrStat(ErrID_Fatal,'TrimCase must be either 1, 2, or 3.',ErrStat, ErrMsg, RoutineName) + end if + + if (p%TrimTol <= epsilon(p%TrimTol)) call SetErrStat(ErrID_Fatal,'TrimTol must be larger than '//trim(num2lstr(epsilon(p%TrimTol)))//'.',ErrStat, ErrMsg, RoutineName) + if (p%Twr_Kdmp < 0.0_ReKi) call SetErrStat(ErrID_Fatal,'Twr_Kdmp must not be negative.',ErrStat, ErrMsg, RoutineName) + if (p%Bld_Kdmp < 0.0_ReKi) call SetErrStat(ErrID_Fatal,'Bld_Kdmp must not be negative.',ErrStat, ErrMsg, RoutineName) + else + + if (.not. allocated(m_FAST%Lin%LinTimes)) then + call SetErrStat(ErrID_Fatal, 'NLinTimes must be at least 1 for linearization analysis.',ErrStat, ErrMsg, RoutineName) + else + do i=1,p%NLinTimes + if (m_FAST%Lin%LinTimes(i) < 0) call SetErrStat(ErrID_Fatal,'LinTimes must be positive values.',ErrStat, ErrMsg, RoutineName) + end do + do i=2,p%NLinTimes + if (m_FAST%Lin%LinTimes(i) <= m_FAST%Lin%LinTimes(i-1)) call SetErrStat(ErrID_Fatal,'LinTimes must be unique values entered in increasing order.',ErrStat, ErrMsg, RoutineName) + end do + + if (m_FAST%Lin%LinTimes(p%NLinTimes) > p%TMax) call SetErrStat(ErrID_Info, 'Tmax is less than the last linearization time. Linearization analysis will not be performed after TMax.',ErrStat, ErrMsg, RoutineName) + end if + + end if if (p%LinInputs < LIN_NONE .or. p%LinInputs > LIN_ALL) call SetErrStat(ErrID_Fatal,'LinInputs must be 0, 1, or 2.',ErrStat, ErrMsg, RoutineName) if (p%LinOutputs < LIN_NONE .or. p%LinOutputs > LIN_ALL) call SetErrStat(ErrID_Fatal,'LinOutputs must be 0, 1, or 2.',ErrStat, ErrMsg, RoutineName) @@ -1753,9 +1677,9 @@ SUBROUTINE ValidateInputData(p, ErrStat, ErrMsg) ! now, make sure we haven't asked for any modules that we can't yet linearize: if (p%CompInflow == MODULE_OpFM) call SetErrStat(ErrID_Fatal,'Linearization is not implemented for the OpenFOAM coupling.',ErrStat, ErrMsg, RoutineName) if (p%CompAero == MODULE_AD14) call SetErrStat(ErrID_Fatal,'Linearization is not implemented for the AeroDyn v14 module.',ErrStat, ErrMsg, RoutineName) - if (p%CompSub == MODULE_SD) call SetErrStat(ErrID_Fatal,'Linearization is not implemented for the SubDyn module.',ErrStat, ErrMsg, RoutineName) - if (p%CompMooring == MODULE_MD) call SetErrStat(ErrID_Fatal,'Linearization is not implemented MoorDyn.', ErrStat, ErrMsg, RoutineName) - if (p%CompMooring == MODULE_FEAM) call SetErrStat(ErrID_Fatal,'Linearization is not implemented FEAMooring.', ErrStat, ErrMsg, RoutineName) + !if (p%CompSub == MODULE_SD) call SetErrStat(ErrID_Fatal,'Linearization is not implemented for the SubDyn module.',ErrStat, ErrMsg, RoutineName) + if (p%CompSub /= MODULE_None) call SetErrStat(ErrID_Fatal,'Linearization is not implemented for the any of the substructure modules.',ErrStat, ErrMsg, RoutineName) + if (p%CompMooring /= MODULE_None .and. p%CompMooring /= MODULE_MAP) call SetErrStat(ErrID_Fatal,'Linearization is not implemented for the FEAMooring or MoorDyn mooring modules.',ErrStat, ErrMsg, RoutineName) if (p%CompIce /= MODULE_None) call SetErrStat(ErrID_Fatal,'Linearization is not implemented for any of the ice loading modules.',ErrStat, ErrMsg, RoutineName) end if @@ -1772,7 +1696,7 @@ SUBROUTINE ValidateInputData(p, ErrStat, ErrMsg) IF ( .NOT. EqualRealNos( p%DT_out, p%DT ) ) THEN IF ( p%DT_out < p%DT ) THEN CALL SetErrStat( ErrID_Fatal, 'DT_out must be at least DT ('//TRIM(Num2LStr(p%DT))//' s).', ErrStat, ErrMsg, RoutineName ) - ELSEIF ( .NOT. EqualRealNos( p%DT_out, p%DT * NINT(p%DT_out / p%DT ) ) ) THEN + ELSEIF ( .NOT. EqualRealNos( p%DT_out, p%DT * p%n_DT_Out ) ) THEN CALL SetErrStat( ErrID_Fatal, 'DT_out must be an integer multiple of DT.', ErrStat, ErrMsg, RoutineName ) END IF END IF @@ -1782,32 +1706,14 @@ SUBROUTINE ValidateInputData(p, ErrStat, ErrMsg) END SUBROUTINE ValidateInputData !---------------------------------------------------------------------------------------------------------------------------------- !> This routine initializes the output for the glue code, including writing the header for the primary output file. -SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, InitOutData_ED, InitOutData_BD, InitOutData_SrvD, InitOutData_AD14, InitOutData_AD, & - InitOutData_IfW, InitOutData_OpFM, InitOutData_HD, InitOutData_SD, InitOutData_ExtPtfm, InitOutData_MAP, & - InitOutData_FEAM, InitOutData_MD, InitOutData_Orca, InitOutData_IceF, InitOutData_IceD, ErrStat, ErrMsg ) +SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, Init, ErrStat, ErrMsg ) IMPLICIT NONE ! Passed variables TYPE(FAST_ParameterType), INTENT(IN) :: p_FAST !< Glue-code simulation parameters TYPE(FAST_OutputFileType), INTENT(INOUT) :: y_FAST !< Glue-code simulation outputs - - TYPE(ED_InitOutputType), INTENT(IN) :: InitOutData_ED !< Initialization output for ElastoDyn - TYPE(BD_InitOutputType), INTENT(IN) :: InitOutData_BD(:) !< Initialization output for BeamDyn (each instance) - TYPE(SrvD_InitOutputType), INTENT(IN) :: InitOutData_SrvD !< Initialization output for ServoDyn - TYPE(AD14_InitOutputType), INTENT(IN) :: InitOutData_AD14 !< Initialization output for AeroDyn14 - TYPE(AD_InitOutputType), INTENT(IN) :: InitOutData_AD !< Initialization output for AeroDyn - TYPE(InflowWind_InitOutputType),INTENT(IN) :: InitOutData_IfW !< Initialization output for InflowWind - TYPE(OpFM_InitOutputType), INTENT(IN) :: InitOutData_OpFM !< Initialization output for OpenFOAM - TYPE(HydroDyn_InitOutputType), INTENT(IN) :: InitOutData_HD !< Initialization output for HydroDyn - TYPE(SD_InitOutputType), INTENT(IN) :: InitOutData_SD !< Initialization output for SubDyn - TYPE(ExtPtfm_InitOutputType), INTENT(IN) :: InitOutData_ExtPtfm !< Initialization output for ExtPtfm_MCKF - TYPE(MAP_InitOutputType), INTENT(IN) :: InitOutData_MAP !< Initialization output for MAP - TYPE(Orca_InitOutputType), INTENT(IN) :: InitOutData_Orca !< Initialization output for OrcaFlex interface - TYPE(FEAM_InitOutputType), INTENT(IN) :: InitOutData_FEAM !< Initialization output for FEAMooring - TYPE(MD_InitOutputType), INTENT(IN) :: InitOutData_MD !< Initialization output for MoorDyn - TYPE(IceFloe_InitOutputType), INTENT(IN) :: InitOutData_IceF !< Initialization output for IceFloe - TYPE(IceD_InitOutputType), INTENT(IN) :: InitOutData_IceD !< Initialization output for IceDyn + TYPE(FAST_InitData), INTENT(IN) :: Init !< Initialization data for all modules INTEGER(IntKi), INTENT(OUT) :: ErrStat !< Error status CHARACTER(*), INTENT(OUT) :: ErrMsg !< Error message corresponding to ErrStat @@ -1816,7 +1722,6 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, InitOutData_ED, InitOutData_BD, Init ! Local variables. INTEGER(IntKi) :: I, J ! Generic index for DO loops. - INTEGER(IntKi) :: indxLast ! The index of the last value to be written to an array INTEGER(IntKi) :: indxNext ! The index of the next value to be written to an array INTEGER(IntKi) :: NumOuts ! number of channels to be written to the output file(s) @@ -1834,68 +1739,68 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, InitOutData_ED, InitOutData_BD, Init ! and save the module version info for later use, too: !...................................................... - y_FAST%Module_Ver( Module_ED ) = InitOutData_ED%Ver - y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_ED ) )) + y_FAST%Module_Ver( Module_ED ) = Init%OutData_ED%Ver + y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_ED ) )) IF ( p_FAST%CompElast == Module_BD ) THEN - y_FAST%Module_Ver( Module_BD ) = InitOutData_BD(1)%Ver ! call copy routine for this type if it every uses dynamic memory + y_FAST%Module_Ver( Module_BD ) = Init%OutData_BD(1)%Ver ! call copy routine for this type if it every uses dynamic memory y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_BD ))) END IF IF ( p_FAST%CompInflow == Module_IfW ) THEN - y_FAST%Module_Ver( Module_IfW ) = InitOutData_IfW%Ver ! call copy routine for this type if it every uses dynamic memory + y_FAST%Module_Ver( Module_IfW ) = Init%OutData_IfW%Ver ! call copy routine for this type if it every uses dynamic memory y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_IfW ))) ELSEIF ( p_FAST%CompInflow == Module_OpFM ) THEN - y_FAST%Module_Ver( Module_OpFM ) = InitOutData_OpFM%Ver ! call copy routine for this type if it every uses dynamic memory + y_FAST%Module_Ver( Module_OpFM ) = Init%OutData_OpFM%Ver ! call copy routine for this type if it every uses dynamic memory y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_OpFM ))) END IF IF ( p_FAST%CompAero == Module_AD14 ) THEN - y_FAST%Module_Ver( Module_AD14 ) = InitOutData_AD14%Ver + y_FAST%Module_Ver( Module_AD14 ) = Init%OutData_AD14%Ver y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_AD14 ) )) ELSEIF ( p_FAST%CompAero == Module_AD ) THEN - y_FAST%Module_Ver( Module_AD ) = InitOutData_AD%Ver + y_FAST%Module_Ver( Module_AD ) = Init%OutData_AD%Ver y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_AD ) )) END IF IF ( p_FAST%CompServo == Module_SrvD ) THEN - y_FAST%Module_Ver( Module_SrvD ) = InitOutData_SrvD%Ver + y_FAST%Module_Ver( Module_SrvD ) = Init%OutData_SrvD%Ver y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_SrvD ))) END IF IF ( p_FAST%CompHydro == Module_HD ) THEN - y_FAST%Module_Ver( Module_HD ) = InitOutData_HD%Ver + y_FAST%Module_Ver( Module_HD ) = Init%OutData_HD%Ver y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_HD ))) END IF IF ( p_FAST%CompSub == Module_SD ) THEN - y_FAST%Module_Ver( Module_SD ) = InitOutData_SD%Ver + y_FAST%Module_Ver( Module_SD ) = Init%OutData_SD%Ver y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_SD ))) ELSE IF ( p_FAST%CompSub == Module_ExtPtfm ) THEN - y_FAST%Module_Ver( Module_ExtPtfm ) = InitOutData_ExtPtfm%Ver + y_FAST%Module_Ver( Module_ExtPtfm ) = Init%OutData_ExtPtfm%Ver y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_ExtPtfm ))) END IF IF ( p_FAST%CompMooring == Module_MAP ) THEN - y_FAST%Module_Ver( Module_MAP ) = InitOutData_MAP%Ver + y_FAST%Module_Ver( Module_MAP ) = Init%OutData_MAP%Ver y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_MAP ))) ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN - y_FAST%Module_Ver( Module_MD ) = InitOutData_MD%Ver + y_FAST%Module_Ver( Module_MD ) = Init%OutData_MD%Ver y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_MD ))) ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN - y_FAST%Module_Ver( Module_FEAM ) = InitOutData_FEAM%Ver + y_FAST%Module_Ver( Module_FEAM ) = Init%OutData_FEAM%Ver y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_FEAM ))) ELSEIF ( p_FAST%CompMooring == Module_Orca ) THEN - y_FAST%Module_Ver( Module_Orca ) = InitOutData_Orca%Ver + y_FAST%Module_Ver( Module_Orca ) = Init%OutData_Orca%Ver y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_Orca))) END IF IF ( p_FAST%CompIce == Module_IceF ) THEN - y_FAST%Module_Ver( Module_IceF ) = InitOutData_IceF%Ver + y_FAST%Module_Ver( Module_IceF ) = Init%OutData_IceF%Ver y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_IceF ))) ELSEIF ( p_FAST%CompIce == Module_IceD ) THEN - y_FAST%Module_Ver( Module_IceD ) = InitOutData_IceD%Ver + y_FAST%Module_Ver( Module_IceD ) = Init%OutData_IceD%Ver y_FAST%FileDescLines(2) = TRIM(y_FAST%FileDescLines(2) ) //'; '//TRIM(GetNVD(y_FAST%Module_Ver( Module_IceD ))) END IF @@ -1907,25 +1812,26 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, InitOutData_ED, InitOutData_BD, Init !y_FAST%numOuts(Module_InfW) = 3 !hack for now: always output 3 wind speeds at hub-height - IF ( ALLOCATED( InitOutData_IfW%WriteOutputHdr ) ) y_FAST%numOuts(Module_IfW) = SIZE(InitOutData_IfW%WriteOutputHdr) - IF ( ALLOCATED( InitOutData_OpFM%WriteOutputHdr ) ) y_FAST%numOuts(Module_OpFM) = SIZE(InitOutData_OpFM%WriteOutputHdr) - IF ( ALLOCATED( InitOutData_ED%WriteOutputHdr ) ) y_FAST%numOuts(Module_ED) = SIZE(InitOutData_ED%WriteOutputHdr) + IF ( ALLOCATED( Init%OutData_IfW%WriteOutputHdr ) ) y_FAST%numOuts(Module_IfW) = SIZE(Init%OutData_IfW%WriteOutputHdr) + IF ( ALLOCATED( Init%OutData_OpFM%WriteOutputHdr ) ) y_FAST%numOuts(Module_OpFM) = SIZE(Init%OutData_OpFM%WriteOutputHdr) + IF ( ALLOCATED( Init%OutData_ED%WriteOutputHdr ) ) y_FAST%numOuts(Module_ED) = SIZE(Init%OutData_ED%WriteOutputHdr) do i=1,p_FAST%nBeams - IF ( ALLOCATED( InitOutData_BD(i)%WriteOutputHdr) ) y_FAST%numOuts(Module_BD) = y_FAST%numOuts(Module_BD) + SIZE(InitOutData_BD(i)%WriteOutputHdr) + IF ( ALLOCATED( Init%OutData_BD(i)%WriteOutputHdr) ) y_FAST%numOuts(Module_BD) = y_FAST%numOuts(Module_BD) + SIZE(Init%OutData_BD(i)%WriteOutputHdr) end do +!ad14 doesn't have outputs: y_FAST%numOuts(Module_AD14) = 0 - IF ( ALLOCATED( InitOutData_AD%WriteOutputHdr ) ) y_FAST%numOuts(Module_AD) = SIZE(InitOutData_AD%WriteOutputHdr) - IF ( ALLOCATED( InitOutData_SrvD%WriteOutputHdr ) ) y_FAST%numOuts(Module_SrvD) = SIZE(InitOutData_SrvD%WriteOutputHdr) - IF ( ALLOCATED( InitOutData_HD%WriteOutputHdr ) ) y_FAST%numOuts(Module_HD) = SIZE(InitOutData_HD%WriteOutputHdr) - IF ( ALLOCATED( InitOutData_SD%WriteOutputHdr ) ) y_FAST%numOuts(Module_SD) = SIZE(InitOutData_SD%WriteOutputHdr) - IF ( ALLOCATED( InitOutData_ExtPtfm%WriteOutputHdr) ) y_FAST%numOuts(Module_ExtPtfm)= SIZE(InitOutData_ExtPtfm%WriteOutputHdr) - IF ( ALLOCATED( InitOutData_MAP%WriteOutputHdr ) ) y_FAST%numOuts(Module_MAP) = SIZE(InitOutData_MAP%WriteOutputHdr) - IF ( ALLOCATED( InitOutData_FEAM%WriteOutputHdr ) ) y_FAST%numOuts(Module_FEAM) = SIZE(InitOutData_FEAM%WriteOutputHdr) - IF ( ALLOCATED( InitOutData_MD%WriteOutputHdr ) ) y_FAST%numOuts(Module_MD) = SIZE(InitOutData_MD%WriteOutputHdr) - IF ( ALLOCATED( InitOutData_Orca%WriteOutputHdr ) ) y_FAST%numOuts(Module_Orca) = SIZE(InitOutData_Orca%WriteOutputHdr) - IF ( ALLOCATED( InitOutData_IceF%WriteOutputHdr ) ) y_FAST%numOuts(Module_IceF) = SIZE(InitOutData_IceF%WriteOutputHdr) - IF ( ALLOCATED( InitOutData_IceD%WriteOutputHdr ) ) y_FAST%numOuts(Module_IceD) = SIZE(InitOutData_IceD%WriteOutputHdr)*p_FAST%numIceLegs + IF ( ALLOCATED( Init%OutData_AD%WriteOutputHdr ) ) y_FAST%numOuts(Module_AD) = SIZE(Init%OutData_AD%WriteOutputHdr) + IF ( ALLOCATED( Init%OutData_SrvD%WriteOutputHdr ) ) y_FAST%numOuts(Module_SrvD) = SIZE(Init%OutData_SrvD%WriteOutputHdr) + IF ( ALLOCATED( Init%OutData_HD%WriteOutputHdr ) ) y_FAST%numOuts(Module_HD) = SIZE(Init%OutData_HD%WriteOutputHdr) + IF ( ALLOCATED( Init%OutData_SD%WriteOutputHdr ) ) y_FAST%numOuts(Module_SD) = SIZE(Init%OutData_SD%WriteOutputHdr) + IF ( ALLOCATED( Init%OutData_ExtPtfm%WriteOutputHdr) ) y_FAST%numOuts(Module_ExtPtfm)= SIZE(Init%OutData_ExtPtfm%WriteOutputHdr) + IF ( ALLOCATED( Init%OutData_MAP%WriteOutputHdr ) ) y_FAST%numOuts(Module_MAP) = SIZE(Init%OutData_MAP%WriteOutputHdr) + IF ( ALLOCATED( Init%OutData_FEAM%WriteOutputHdr ) ) y_FAST%numOuts(Module_FEAM) = SIZE(Init%OutData_FEAM%WriteOutputHdr) + IF ( ALLOCATED( Init%OutData_MD%WriteOutputHdr ) ) y_FAST%numOuts(Module_MD) = SIZE(Init%OutData_MD%WriteOutputHdr) + IF ( ALLOCATED( Init%OutData_Orca%WriteOutputHdr ) ) y_FAST%numOuts(Module_Orca) = SIZE(Init%OutData_Orca%WriteOutputHdr) + IF ( ALLOCATED( Init%OutData_IceF%WriteOutputHdr ) ) y_FAST%numOuts(Module_IceF) = SIZE(Init%OutData_IceF%WriteOutputHdr) + IF ( ALLOCATED( Init%OutData_IceD%WriteOutputHdr ) ) y_FAST%numOuts(Module_IceD) = SIZE(Init%OutData_IceD%WriteOutputHdr)*p_FAST%numIceLegs !...................................................... ! Initialize the output channel names and units @@ -1940,35 +1846,31 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, InitOutData_ED, InitOutData_BD, Init y_FAST%ChannelNames(1) = 'Time' y_FAST%ChannelUnits(1) = '(s)' - indxLast = 1 indxNext = 2 + DO i=1,y_FAST%numOuts(Module_IfW) !InflowWind + y_FAST%ChannelNames(indxNext) = Init%OutData_IfW%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = Init%OutData_IfW%WriteOutputUnt(i) + indxNext = indxNext + 1 + END DO - IF ( y_FAST%numOuts(Module_IfW) > 0_IntKi ) THEN - indxLast = indxNext + y_FAST%numOuts(Module_IfW) - 1 - y_FAST%ChannelNames(indxNext:indxLast) = InitOutData_IfW%WriteOutputHdr - y_FAST%ChannelUnits(indxNext:indxLast) = InitOutData_IfW%WriteOutputUnt - indxNext = indxLast + 1 - ELSEIF ( y_FAST%numOuts(Module_OpFM) > 0_IntKi ) THEN - indxLast = indxNext + y_FAST%numOuts(Module_OpFM) - 1 - y_FAST%ChannelNames(indxNext:indxLast) = InitOutData_OpFM%WriteOutputHdr - y_FAST%ChannelUnits(indxNext:indxLast) = InitOutData_OpFM%WriteOutputUnt - indxNext = indxLast + 1 - END IF - + DO i=1,y_FAST%numOuts(Module_OpFM) !OpenFOAM + y_FAST%ChannelNames(indxNext) = Init%OutData_OpFM%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = Init%OutData_OpFM%WriteOutputUnt(i) + indxNext = indxNext + 1 + END DO - IF ( y_FAST%numOuts(Module_ED) > 0_IntKi ) THEN !ElastoDyn - indxLast = indxNext + y_FAST%numOuts(Module_ED) - 1 - y_FAST%ChannelNames(indxNext:indxLast) = InitOutData_ED%WriteOutputHdr - y_FAST%ChannelUnits(indxNext:indxLast) = InitOutData_ED%WriteOutputUnt - indxNext = indxLast + 1 - END IF + DO i=1,y_FAST%numOuts(Module_ED) !ElastoDyn + y_FAST%ChannelNames(indxNext) = Init%OutData_ED%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = Init%OutData_ED%WriteOutputUnt(i) + indxNext = indxNext + 1 + END DO IF ( y_FAST%numOuts(Module_BD) > 0_IntKi ) THEN !BeamDyn do i=1,p_FAST%nBeams - if ( allocated(InitOutData_BD(i)%WriteOutputHdr) ) then - do j=1,size(InitOutData_BD(i)%WriteOutputHdr) - y_FAST%ChannelNames(indxNext) = 'B'//TRIM(Num2Lstr(i))//trim(InitOutData_BD(i)%WriteOutputHdr(j)) - y_FAST%ChannelUnits(indxNext) = InitOutData_BD(i)%WriteOutputUnt(j) + if ( allocated(Init%OutData_BD(i)%WriteOutputHdr) ) then + do j=1,size(Init%OutData_BD(i)%WriteOutputHdr) + y_FAST%ChannelNames(indxNext) = 'B'//TRIM(Num2Lstr(i))//trim(Init%OutData_BD(i)%WriteOutputHdr(j)) + y_FAST%ChannelUnits(indxNext) = Init%OutData_BD(i)%WriteOutputUnt(j) indxNext = indxNext + 1 end do ! j end if @@ -1976,77 +1878,73 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, InitOutData_ED, InitOutData_BD, Init END IF - ! none for AeroDyn14 - - IF ( y_FAST%numOuts(Module_AD) > 0_IntKi ) THEN !AeroDyn - indxLast = indxNext + y_FAST%numOuts(Module_AD) - 1 - y_FAST%ChannelNames(indxNext:indxLast) = InitOutData_AD%WriteOutputHdr - y_FAST%ChannelUnits(indxNext:indxLast) = InitOutData_AD%WriteOutputUnt - indxNext = indxLast + 1 - END IF - - - IF ( y_FAST%numOuts(Module_SrvD) > 0_IntKi ) THEN !ServoDyn - indxLast = indxNext + y_FAST%numOuts(Module_SrvD) - 1 - y_FAST%ChannelNames(indxNext:indxLast) = InitOutData_SrvD%WriteOutputHdr - y_FAST%ChannelUnits(indxNext:indxLast) = InitOutData_SrvD%WriteOutputUnt - indxNext = indxLast + 1 - END IF - - IF ( y_FAST%numOuts(Module_HD) > 0_IntKi ) THEN !HydroDyn - indxLast = indxNext + y_FAST%numOuts(Module_HD) - 1 - y_FAST%ChannelNames(indxNext:indxLast) = InitOutData_HD%WriteOutputHdr - y_FAST%ChannelUnits(indxNext:indxLast) = InitOutData_HD%WriteOutputUnt - indxNext = indxLast + 1 - END IF - - - IF ( y_FAST%numOuts(Module_SD) > 0_IntKi ) THEN !SubDyn - indxLast = indxNext + y_FAST%numOuts(Module_SD) - 1 - y_FAST%ChannelNames(indxNext:indxLast) = InitOutData_SD%WriteOutputHdr - y_FAST%ChannelUnits(indxNext:indxLast) = InitOutData_SD%WriteOutputUnt - indxNext = indxLast + 1 - ELSEIF ( y_FAST%numOuts(Module_ExtPtfm) > 0_IntKi ) THEN !ExtPtfm_MCKF - indxLast = indxNext + y_FAST%numOuts(Module_ExtPtfm) - 1 - y_FAST%ChannelNames(indxNext:indxLast) = InitOutData_ExtPtfm%WriteOutputHdr - y_FAST%ChannelUnits(indxNext:indxLast) = InitOutData_ExtPtfm%WriteOutputUnt - indxNext = indxLast + 1 - END IF - - - IF ( y_FAST%numOuts(Module_MAP) > 0_IntKi ) THEN !MAP - indxLast = indxNext + y_FAST%numOuts(Module_MAP) - 1 - y_FAST%ChannelNames(indxNext:indxLast) = InitOutData_MAP%WriteOutputHdr - y_FAST%ChannelUnits(indxNext:indxLast) = InitOutData_MAP%WriteOutputUnt - indxNext = indxLast + 1 - ELSEIF ( y_FAST%numOuts(Module_MD) > 0_IntKi ) THEN !MoorDyn - indxLast = indxNext + y_FAST%numOuts(Module_MD) - 1 - y_FAST%ChannelNames(indxNext:indxLast) = InitOutData_MD%WriteOutputHdr - y_FAST%ChannelUnits(indxNext:indxLast) = InitOutData_MD%WriteOutputUnt - indxNext = indxLast + 1 - ELSEIF ( y_FAST%numOuts(Module_FEAM) > 0_IntKi ) THEN !FEAMooring - indxLast = indxNext + y_FAST%numOuts(Module_FEAM) - 1 - y_FAST%ChannelNames(indxNext:indxLast) = InitOutData_FEAM%WriteOutputHdr - y_FAST%ChannelUnits(indxNext:indxLast) = InitOutData_FEAM%WriteOutputUnt - indxNext = indxLast + 1 - ELSEIF ( y_FAST%numOuts(Module_Orca) > 0_IntKi ) THEN !OrcaFlex - indxLast = indxNext + y_FAST%numOuts(Module_Orca) - 1 - y_FAST%ChannelNames(indxNext:indxLast) = InitOutData_Orca%WriteOutputHdr - y_FAST%ChannelUnits(indxNext:indxLast) = InitOutData_Orca%WriteOutputUnt - indxNext = indxLast + 1 - END IF - - - IF ( y_FAST%numOuts(Module_IceF) > 0_IntKi ) THEN !IceFloe - indxLast = indxNext + y_FAST%numOuts(Module_IceF) - 1 - y_FAST%ChannelNames(indxNext:indxLast) = InitOutData_IceF%WriteOutputHdr - y_FAST%ChannelUnits(indxNext:indxLast) = InitOutData_IceF%WriteOutputUnt - indxNext = indxLast + 1 - ELSEIF ( y_FAST%numOuts(Module_IceD) > 0_IntKi ) THEN !IceDyn + ! none for AeroDyn14 + + DO i=1,y_FAST%numOuts(Module_AD) !AeroDyn + y_FAST%ChannelNames(indxNext) = Init%OutData_AD%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = Init%OutData_AD%WriteOutputUnt(i) + indxNext = indxNext + 1 + END DO + + DO i=1,y_FAST%numOuts(Module_SrvD) !ServoDyn + y_FAST%ChannelNames(indxNext) = Init%OutData_SrvD%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = Init%OutData_SrvD%WriteOutputUnt(i) + indxNext = indxNext + 1 + END DO + + DO i=1,y_FAST%numOuts(Module_HD) !HydroDyn + y_FAST%ChannelNames(indxNext) = Init%OutData_HD%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = Init%OutData_HD%WriteOutputUnt(i) + indxNext = indxNext + 1 + END DO + + DO i=1,y_FAST%numOuts(Module_SD) !SubDyn + y_FAST%ChannelNames(indxNext) = Init%OutData_SD%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = Init%OutData_SD%WriteOutputUnt(i) + indxNext = indxNext + 1 + END DO + + DO i=1,y_FAST%numOuts(Module_ExtPtfm) !ExtPtfm_MCKF + y_FAST%ChannelNames(indxNext) = Init%OutData_ExtPtfm%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = Init%OutData_ExtPtfm%WriteOutputUnt(i) + indxNext = indxNext + 1 + END DO + + DO i=1,y_FAST%numOuts(Module_MAP) !MAP + y_FAST%ChannelNames(indxNext) = Init%OutData_MAP%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = Init%OutData_MAP%WriteOutputUnt(i) + indxNext = indxNext + 1 + END DO + + DO i=1,y_FAST%numOuts(Module_MD) !MoorDyn + y_FAST%ChannelNames(indxNext) = Init%OutData_MD%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = Init%OutData_MD%WriteOutputUnt(i) + indxNext = indxNext + 1 + END DO + + DO i=1,y_FAST%numOuts(Module_FEAM) !FEAMooring + y_FAST%ChannelNames(indxNext) = Init%OutData_FEAM%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = Init%OutData_FEAM%WriteOutputUnt(i) + indxNext = indxNext + 1 + END DO + + DO i=1,y_FAST%numOuts(Module_Orca) !OrcaFlex + y_FAST%ChannelNames(indxNext) = Init%OutData_Orca%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = Init%OutData_Orca%WriteOutputUnt(i) + indxNext = indxNext + 1 + END DO + + DO i=1,y_FAST%numOuts(Module_IceF) !IceFloe + y_FAST%ChannelNames(indxNext) = Init%OutData_IceF%WriteOutputHdr(i) + y_FAST%ChannelUnits(indxNext) = Init%OutData_IceF%WriteOutputUnt(i) + indxNext = indxNext + 1 + END DO + + IF ( y_FAST%numOuts(Module_IceD) > 0_IntKi ) THEN !IceDyn DO I=1,p_FAST%numIceLegs - DO J=1,SIZE(InitOutData_IceD%WriteOutputHdr) - y_FAST%ChannelNames(indxNext) =TRIM(InitOutData_IceD%WriteOutputHdr(J))//'L'//TRIM(Num2Lstr(I)) !bjj: do we want this "Lx" at the end? - y_FAST%ChannelUnits(indxNext) = InitOutData_IceD%WriteOutputUnt(J) + DO J=1,SIZE(Init%OutData_IceD%WriteOutputHdr) + y_FAST%ChannelNames(indxNext) =TRIM(Init%OutData_IceD%WriteOutputHdr(J))//'L'//TRIM(Num2Lstr(I)) !bjj: do we want this "Lx" at the end? + y_FAST%ChannelUnits(indxNext) = Init%OutData_IceD%WriteOutputUnt(J) indxNext = indxNext + 1 END DO ! J END DO ! I @@ -2059,6 +1957,17 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, InitOutData_ED, InitOutData_BD, Init IF (p_FAST%WrTxtOutFile) THEN + y_FAST%ActualChanLen = max( MinChanLen, p_FAST%FmtWidth ) + DO I=1,NumOuts + y_FAST%ActualChanLen = max( y_FAST%ActualChanLen, LEN_TRIM(y_FAST%ChannelNames(I)) ) + y_FAST%ActualChanLen = max( y_FAST%ActualChanLen, LEN_TRIM(y_FAST%ChannelUnits(I)) ) + ENDDO ! I + + y_FAST%OutFmt_a = '"'//p_FAST%Delim//'"'//p_FAST%OutFmt ! format for array elements from individual modules + if (p_FAST%FmtWidth < y_FAST%ActualChanLen) then + y_FAST%OutFmt_a = trim(y_FAST%OutFmt_a)//','//trim(num2lstr(y_FAST%ActualChanLen - p_FAST%FmtWidth))//'x' + end if + CALL GetNewUnit( y_FAST%UnOu, ErrStat, ErrMsg ) IF ( ErrStat >= AbortErrLev ) RETURN @@ -2077,12 +1986,21 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, InitOutData_ED, InitOutData_BD, Init !...................................................... ! Write the names of the output parameters on one line: !...................................................... + if (p_FAST%Delim /= " ") then ! trim trailing spaces if not space delimited: - CALL WrFileNR ( y_FAST%UnOu, y_FAST%ChannelNames(1) ) + CALL WrFileNR ( y_FAST%UnOu, trim(y_FAST%ChannelNames(1)) ) ! first one is time, with a special format - DO I=2,NumOuts - CALL WrFileNR ( y_FAST%UnOu, p_FAST%Delim//y_FAST%ChannelNames(I) ) - ENDDO ! I + DO I=2,NumOuts + CALL WrFileNR ( y_FAST%UnOu, p_FAST%Delim//trim(y_FAST%ChannelNames(I)) ) + ENDDO ! I + else + + CALL WrFileNR ( y_FAST%UnOu, y_FAST%ChannelNames(1)(1:p_FAST%TChanLen) ) ! first one is time, with a special format + + DO I=2,NumOuts + CALL WrFileNR ( y_FAST%UnOu, p_FAST%Delim//y_FAST%ChannelNames(I)(1:y_FAST%ActualChanLen) ) + ENDDO ! I + end if WRITE (y_FAST%UnOu,'()') @@ -2090,11 +2008,21 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, InitOutData_ED, InitOutData_BD, Init ! Write the units of the output parameters on one line: !...................................................... - CALL WrFileNR ( y_FAST%UnOu, y_FAST%ChannelUnits(1) ) + if (p_FAST%Delim /= " ") then + + CALL WrFileNR ( y_FAST%UnOu, trim(y_FAST%ChannelUnits(1)) ) - DO I=2,NumOuts - CALL WrFileNR ( y_FAST%UnOu, p_FAST%Delim//y_FAST%ChannelUnits(I) ) - ENDDO ! I + DO I=2,NumOuts + CALL WrFileNR ( y_FAST%UnOu, p_FAST%Delim//trim(y_FAST%ChannelUnits(I)) ) + ENDDO ! I + else + + CALL WrFileNR ( y_FAST%UnOu, y_FAST%ChannelUnits(1)(1:p_FAST%TChanLen) ) + + DO I=2,NumOuts + CALL WrFileNR ( y_FAST%UnOu, p_FAST%Delim//y_FAST%ChannelUnits(I)(1:y_FAST%ActualChanLen) ) + ENDDO ! I + end if WRITE (y_FAST%UnOu,'()') @@ -2109,6 +2037,7 @@ SUBROUTINE FAST_InitOutput( p_FAST, y_FAST, InitOutData_ED, InitOutData_BD, Init y_FAST%NOutSteps = CEILING ( (p_FAST%TMax - p_FAST%TStart) / p_FAST%DT_OUT ) + 1 CALL AllocAry( y_FAST%AllOutData, NumOuts-1, y_FAST%NOutSteps, 'AllOutData', ErrStat, ErrMsg ) + y_FAST%AllOutData = 0.0_ReKi IF ( ErrStat >= AbortErrLev ) RETURN IF ( p_FAST%WrBinMod == FileFmtID_WithTime ) THEN ! we store the entire time array @@ -2133,12 +2062,13 @@ END SUBROUTINE FAST_InitOutput !---------------------------------------------------------------------------------------------------------------------------------- !> This routine reads in the primary FAST input file, does some validation, and places the values it reads in the !! parameter structure (p). It prints to an echo file if requested. -SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, OverrideAbortErrLev, ErrStat, ErrMsg ) +SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, m_FAST, OverrideAbortErrLev, ErrStat, ErrMsg ) IMPLICIT NONE ! Passed variables TYPE(FAST_ParameterType), INTENT(INOUT) :: p !< The parameter data for the FAST (glue-code) simulation + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables CHARACTER(*), INTENT(IN) :: InputFile !< Name of the file containing the primary input data LOGICAL, INTENT(IN) :: OverrideAbortErrLev !< Determines if we should override AbortErrLev INTEGER(IntKi), INTENT(OUT) :: ErrStat !< Error status @@ -2146,7 +2076,6 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, OverrideAbortErrLev, ErrStat, Err ! Local variables: REAL(DbKi) :: TmpRate ! temporary variable to read VTK_fps before converting to #steps based on DT - REAL(DbKi) :: VTK_fps ! temporary variable to read VTK_fps before converting to #steps based on DT REAL(DbKi) :: TmpTime ! temporary variable to read SttsTime and ChkptTime before converting to #steps based on DT INTEGER(IntKi) :: I ! loop counter INTEGER(IntKi) :: UnIn ! Unit number for reading file @@ -2155,7 +2084,6 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, OverrideAbortErrLev, ErrStat, Err INTEGER(IntKi) :: IOS ! Temporary Error status INTEGER(IntKi) :: ErrStat2 ! Temporary Error status INTEGER(IntKi) :: OutFileFmt ! An integer that indicates what kind of tabular output should be generated (1=text, 2=binary, 3=both) - INTEGER(IntKi) :: NLinTimes ! An integer that indicates how many times to linearize LOGICAL :: Echo ! Determines if an echo file should be written LOGICAL :: TabDelim ! Determines if text output should be delimited by tabs (true) or space (false) CHARACTER(ErrMsgLen) :: ErrMsg2 ! Temporary Error message @@ -2664,6 +2592,8 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, OverrideAbortErrLev, ErrStat, Err end if END IF + p%n_DT_Out = NINT( p%DT_Out / p%DT ) + ! TStart - Time to begin tabular output (s): CALL ReadVar( UnIn, InputFile, p%TStart, "TStart", "Time to begin tabular output (s)", ErrStat2, ErrMsg2, UnEc) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2672,44 +2602,60 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, OverrideAbortErrLev, ErrStat, Err RETURN end if + + !> OutFileFmt - Format for tabular (time-marching) output file (switch) {1: text file [.out], 2: binary file [.outb], 4: HDF5 [.h5], add for combinations} + !! + !! Combinations of output files are possible by adding the values corresponding to each file. The possible combination of options are therefore + !! + !! | `OutFileFmt` | Description | + !! |:------------:|:---------------------------------------------------------------------| + !! | 1 | Text file only `.out` | + !! | 2 | Binary file only `.outb` | + !! | 3 | Text and binary files | + !! | 4 | uncompressed binary file `.outbu` | + !! | 5 | Text and uncompressed binary files | + !! | 6 => 4 | Binary (not written) and uncompressed binary files; same as 4 | + !! | 7 => 5 | Text, Binary (not written), and uncompressed binary files; same as 5 | + !! + ! OutFileFmt - Format for tabular (time-marching) output file(s) (1: text file [.out], 2: binary file [.outb], 3: both) (-): - CALL ReadVar( UnIn, InputFile, OutFileFmt, "OutFileFmt", "Format for tabular (time-marching) output file(s) (0: uncompressed binary and text file, 1: text file [.out], 2: compressed binary file [.outb], 3: both text and compressed binary) (-)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InputFile, OutFileFmt, "OutFileFmt", "Format for tabular (time-marching) output file(s) {0: uncompressed binary and text file, 1: text file [.out], 2: compressed binary file [.outb], 3: both text and compressed binary, 4: uncompressed binary .outb]; add for combinations) (-)", ErrStat2, ErrMsg2, UnEc) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if ( ErrStat >= AbortErrLev ) then call cleanup() - RETURN + RETURN end if + + if (OutFileFmt == 0) OutFileFmt = 5 + + ! convert integer to binary representation of which file formats to generate: + p%WrTxtOutFile = mod(OutFileFmt,2) == 1 -#if defined COMPILE_SIMULINK || defined COMPILE_LABVIEW - !bjj: 2015-03-03: not sure this is still necessary... - p%WrBinMod = FileFmtID_WithTime ! We cannot guarantee the output time step is constant in binary files -#else - p%WrBinMod = FileFmtID_WithoutTime ! A format specifier for the binary output file format (1=include time channel as packed 32-bit binary; 2=don't include time channel;3=don't include time channel and do not pack data) -#endif - - SELECT CASE (OutFileFmt) - CASE (0_IntKi) - ! This is an undocumented feature for the regression testing system. It writes both text and binary output, but the binary is stored as uncompressed double floating point data instead of compressed int16 data. - p%WrBinOutFile = .TRUE. - p%WrBinMod = FileFmtID_NoCompressWithoutTime ! A format specifier for the binary output file format (3=don't include time channel and do not pack data) - p%WrTxtOutFile = .TRUE. - CASE (1_IntKi) - p%WrBinOutFile = .FALSE. - p%WrTxtOutFile = .TRUE. - CASE (2_IntKi) - p%WrBinOutFile = .TRUE. - p%WrTxtOutFile = .FALSE. - CASE (3_IntKi) - p%WrBinOutFile = .TRUE. - p%WrTxtOutFile = .TRUE. - CASE DEFAULT - CALL SetErrStat( ErrID_Fatal, "FAST's OutFileFmt must be 0, 1, 2, or 3.",ErrStat,ErrMsg,RoutineName) - if ( ErrStat >= AbortErrLev ) then - call cleanup() - RETURN - end if - END SELECT + OutFileFmt = OutFileFmt / 2 ! integer division + p%WrBinOutFile = mod(OutFileFmt,2) == 1 + + OutFileFmt = OutFileFmt / 2 ! integer division + if (mod(OutFileFmt,2) == 1) then + ! This is a feature for the regression testing system. It writes binary output stored as uncompressed double floating point data instead of compressed int16 data. + ! If the compressed binary version was requested, that will not be generated + if (p%WrBinOutFile) then + call SetErrStat(ErrID_Warn,'Binary compressed file will not be generated because the uncompressed version was also requested.', ErrStat, ErrMsg, RoutineName) + else + p%WrBinOutFile = .true. + end if + p%WrBinMod = FileFmtID_NoCompressWithoutTime ! A format specifier for the binary output file format (3=don't include time channel and do not pack data) + else + p%WrBinMod = FileFmtID_ChanLen_In ! A format specifier for the binary output file format (4=don't include time channel; do include channel width; do pack data) + end if + OutFileFmt = OutFileFmt / 2 ! integer division + + if (OutFileFmt /= 0) then + call SetErrStat( ErrID_Fatal, "OutFileFmt must be 0, 1, 2, or 3.",ErrStat,ErrMsg,RoutineName) + call cleanup() + return + end if + ! TabDelim - Use tab delimiters in text tabular output file? (flag): CALL ReadVar( UnIn, InputFile, TabDelim, "TabDelim", "Use tab delimiters in text tabular output file? (flag)", ErrStat2, ErrMsg2, UnEc) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -2750,28 +2696,66 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, OverrideAbortErrLev, ErrStat, Err RETURN end if - ! NLinTimes - Number of times to linearize (-) [>=1] - CALL ReadVar( UnIn, InputFile, NLinTimes, "NLinTimes", "Number of times to linearize (-) [>=1]", ErrStat2, ErrMsg2, UnEc) + + ! CalcSteady - Calculate a steady-state periodic operating point before linearization? [unused if Linearize=False] (flag) + CALL ReadVar( UnIn, InputFile, p%CalcSteady, "CalcSteady", "Calculate a steady-state periodic operating point before linearization? (flag)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! TrimCase - Controller parameter to be trimmed {1:yaw; 2:torque; 3:pitch} [used only if CalcSteady=True] (-) + CALL ReadVar( UnIn, InputFile, p%TrimCase, "TrimCase", "Controller parameter to be trimmed {1:yaw; 2:torque; 3:pitch} (-)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! TrimTol - Tolerance for the rotational speed convergence [used only if CalcSteady=True] (-) + CALL ReadVar( UnIn, InputFile, p%TrimTol, "TrimTol", "Tolerance for the rotational speed convergence (-)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! TrimGain - Proportional gain for the rotational speed error (>0) [used only if CalcSteady=True] (rad/(rad/s) for yaw or pitch; Nm/(rad/s) for torque) + CALL ReadVar( UnIn, InputFile, p%TrimGain, "TrimGain", "Proportional gain for the rotational speed error (>0) (rad/(rad/s) for yaw or pitch; Nm/(rad/s) for torque)", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! Twr_Kdmp - Damping factor for the tower [used only if CalcSteady=True] (N/(m/s)) + CALL ReadVar( UnIn, InputFile, p%Twr_Kdmp, "Twr_Kdmp", "Damping factor for the tower (N/(m/s))", ErrStat2, ErrMsg2, UnEc) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + + ! Bld_Kdmp - Damping factor for the blades [used only if CalcSteady=True] (N/(m/s)) + CALL ReadVar( UnIn, InputFile, p%Bld_Kdmp, "Bld_Kdmp", "Damping factor for the blades (N/(m/s))", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then call cleanup() - RETURN + RETURN end if - + + ! NLinTimes - Number of times to linearize (or number of equally spaced azimuth steps in periodic linearized model) (-) [>=1] + CALL ReadVar( UnIn, InputFile, p%NLinTimes, "NLinTimes", "Number of times to linearize (-) [>=1]", ErrStat2, ErrMsg2, UnEc) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + if (.not. p%Linearize) then + p%CalcSteady = .false. + p%NLinTimes = 0 + end if + ! LinTimes - Times to linearize (s) [1 to NLinTimes] - if (NLinTimes >= 1) then - call AllocAry( p%LinTimes, NLinTimes, 'p%LinTimes', ErrStat2, ErrMsg2 ) + if (.not. p%CalcSteady .and. p%NLinTimes >= 1 ) then + call AllocAry( m_FAST%Lin%LinTimes, p%NLinTimes, 'LinTimes', ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - if (ErrStat < AbortErrLev) then - CALL ReadAry( UnIn, InputFile, p%LinTimes, NLinTimes, "LinTimes", "Times to linearize (s) [1 to NLinTimes]", ErrStat2, ErrMsg2, UnEc) - end if + if ( ErrStat >= AbortErrLev ) then + call cleanup() + RETURN + end if + + CALL ReadAry( UnIn, InputFile, m_FAST%Lin%LinTimes, p%NLinTimes, "LinTimes", "Times to linearize (s) [1 to NLinTimes]", ErrStat2, ErrMsg2, UnEc) else CALL ReadCom( UnIn, InputFile, 'Times to linearize (s) [1 to NLinTimes] ', ErrStat2, ErrMsg2, UnEc ) end if CALL SetErrStat( ErrStat2, ErrMsg2,ErrStat,ErrMsg,RoutineName) if ( ErrStat >= AbortErrLev ) then call cleanup() - RETURN + RETURN end if ! LinInputs - Include inputs in linearization (switch) {0=none; 1=standard; 2=all module inputs (debug)} @@ -2814,15 +2798,15 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, OverrideAbortErrLev, ErrStat, Err RETURN end if - ! WrVTK - VTK Visualization data output: (switch) {0=none; 1=initialization data only; 2=animation}: - CALL ReadVar( UnIn, InputFile, p%WrVTK, "WrVTK", "Write VTK visualization files (0=none; 1=initialization data only; 2=animation)", ErrStat2, ErrMsg2, UnEc) + ! WrVTK - VTK Visualization data output: (switch) {0=none; 1=initialization data only; 2=animation; 3=mode shapes}: + CALL ReadVar( UnIn, InputFile, p%WrVTK, "WrVTK", "Write VTK visualization files (0=none; 1=initialization data only; 2=animation; 3=mode shapes)", ErrStat2, ErrMsg2, UnEc) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if ( ErrStat >= AbortErrLev ) then call cleanup() RETURN end if - IF ( p%WrVTK < 0 .OR. p%WrVTK > 2 ) THEN + IF ( p%WrVTK < 0 .OR. p%WrVTK > 3 ) THEN p%WrVTK = VTK_Unknown END IF @@ -2863,7 +2847,7 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, OverrideAbortErrLev, ErrStat, Err end if ! VTK_fps - Frame rate for VTK output (frames per second) {will use closest integer multiple of DT} - CALL ReadVar( UnIn, InputFile, VTK_fps, "VTK_fps", "Frame rate for VTK output(fps)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InputFile, p%VTK_fps, "VTK_fps", "Frame rate for VTK output(fps)", ErrStat2, ErrMsg2, UnEc) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) if ( ErrStat >= AbortErrLev ) then call cleanup() @@ -2872,24 +2856,26 @@ SUBROUTINE FAST_ReadPrimaryFile( InputFile, p, OverrideAbortErrLev, ErrStat, Err ! convert frames-per-second to seconds per sample: - if ( EqualRealNos(VTK_fps, 0.0_DbKi) ) then + if ( EqualRealNos(p%VTK_fps, 0.0_DbKi) ) then TmpTime = p%TMax + p%DT else - TmpTime = 1.0_DbKi / VTK_fps + TmpTime = 1.0_DbKi / p%VTK_fps end if ! now save the number of time steps between VTK file output: - IF (TmpTime > p%TMax) THEN + IF (p%WrVTK == VTK_ModeShapes) THEN + p%n_VTKTime = 1 + ELSE IF (TmpTime > p%TMax) THEN p%n_VTKTime = HUGE(p%n_VTKTime) - ELSE + ELSE p%n_VTKTime = NINT( TmpTime / p%DT ) ! I'll warn if p%n_VTKTime*p%DT is not TmpTime - IF (p%WrVTK > VTK_None) THEN + IF (p%WrVTK == VTK_Animate) THEN TmpRate = p%n_VTKTime*p%DT if (.not. EqualRealNos(TmpRate, TmpTime)) then call SetErrStat(ErrID_Info, '1/VTK_fps is not an integer multiple of DT. FAST will output VTK information at '//& trim(num2lstr(1.0_DbKi/TmpRate))//' fps, the closest rate possible.',ErrStat,ErrMsg,RoutineName) - end if + end if END IF END IF @@ -2906,38 +2892,6 @@ end subroutine cleanup !............................................................................................................................... END SUBROUTINE FAST_ReadPrimaryFile !---------------------------------------------------------------------------------------------------------------------------------- -!> This function builds the path for the vtk directory based on the output file root -FUNCTION get_vtkdir_path( out_file_root ) - CHARACTER(1024) :: get_vtkdir_path - CHARACTER(*), INTENT(IN) :: out_file_root - INTEGER(IntKi) :: last_separator_index - - ! get the directory of the primary input file (i.e. the case directory); Windows can have either forward or backward slashes (compare with GetPath()) - - last_separator_index = index(out_file_root, '/', back=.true.) - last_separator_index = max( index(out_file_root, '\', back=.true.), last_separator_index ) - - if (last_separator_index==0) then - get_vtkdir_path = '.'//PathSep//'vtk' - else - get_vtkdir_path = trim(out_file_root(1 : last_separator_index) // 'vtk') - end if -END FUNCTION -!---------------------------------------------------------------------------------------------------------------------------------- -!> This function builds the path for the vtk root file name based on the output file root -FUNCTION get_vtkroot_path( out_file_root ) - CHARACTER(1024) :: get_vtkroot_path - CHARACTER(*), INTENT(IN) :: out_file_root - INTEGER(IntKi) :: last_separator_index - INTEGER(IntKi) :: path_length - - last_separator_index = index(out_file_root, '/', back=.true.) - last_separator_index = max( index(out_file_root, '\', back=.true.), last_separator_index ) - - get_vtkroot_path = trim( get_vtkdir_path(out_file_root) ) // PathSep & - // out_file_root( last_separator_index + 1 :) -END FUNCTION -!---------------------------------------------------------------------------------------------------------------------------------- !> This subroutine sets up some of the information needed for plotting VTK surfaces. It initializes only the data needed before !! HD initialization. (HD needs some of this data so it can return the wave elevation data we want.) SUBROUTINE SetVTKParameters_B4HD(p_FAST, InitOutData_ED, InitInData_HD, BD, ErrStat, ErrMsg) @@ -2967,7 +2921,8 @@ SUBROUTINE SetVTKParameters_B4HD(p_FAST, InitOutData_ED, InitInData_HD, BD, ErrS else BladeLength = InitOutData_ED%BladeLength end if - p_FAST%VTK_Surface%GroundRad = BladeLength + InitOutData_ED%HubRad + p_FAST%VTK_Surface%HubRad = InitOutData_ED%HubRad + p_FAST%VTK_Surface%GroundRad = BladeLength + p_FAST%VTK_Surface%HubRad !........................................................................................................ ! We don't use the rest of this routine for stick-figure output @@ -3022,39 +2977,59 @@ SUBROUTINE SetVTKParameters(p_FAST, InitOutData_ED, InitOutData_AD, InitInData_H REAL(SiKi) :: x, y REAL(SiKi) :: TwrDiam_top, TwrDiam_base, TwrRatio, TwrLength INTEGER(IntKi) :: topNode, baseNode - INTEGER(IntKi) :: tipNode, rootNode, cylNode INTEGER(IntKi) :: NumBl, k - CHARACTER(1024) :: VTK_path + CHARACTER(1024) :: vtkroot INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SetVTKParameters' - + + ErrStat = ErrID_None ErrMsg = "" + ! get the name of the output directory for vtk files (in a subdirectory called "vtk" of the output directory), and ! create the VTK directory if it does not exist - call MKDIR( get_vtkdir_path(p_FAST%OutFileRoot) ) + + call GetPath ( p_FAST%OutFileRoot, p_FAST%VTK_OutFileRoot, vtkroot ) ! the returned p_FAST%VTK_OutFileRoot includes a file separator character at the end + p_FAST%VTK_OutFileRoot = trim(p_FAST%VTK_OutFileRoot) // 'vtk' + + call MKDIR( trim(p_FAST%VTK_OutFileRoot) ) + + p_FAST%VTK_OutFileRoot = trim( p_FAST%VTK_OutFileRoot ) // PathSep // trim(vtkroot) + + + ! calculate the number of digits in 'y_FAST%NOutSteps' (Maximum number of output steps to be written) + ! this will be used to pad the write-out step in the VTK filename with zeros in calls to MeshWrVTK() + if (p_FAST%WrVTK == VTK_ModeShapes .AND. p_FAST%VTK_modes%VTKLinTim==1) then + if (p_FAST%NLinTimes < 1) p_FAST%NLinTimes = 1 !in case we reached here with an error + p_FAST%VTK_tWidth = CEILING( log10( real( p_FAST%NLinTimes) ) ) + 1 + else + p_FAST%VTK_tWidth = CEILING( log10( real(p_FAST%n_TMax_m1+1, ReKi) / p_FAST%n_VTKTime ) ) + 1 + end if + + ! determine number of blades + NumBl = InitOutData_ED%NumBl ! initialize the vtk data - p_FAST%VTK_Surface%NumSectors = 18 - p_FAST%VTK_Surface%HubRad = InitOutData_ED%HubRad - ! NOTE: we set p_FAST%VTK_Surface%GroundRad in SetVTKParameters_B4HD + p_FAST%VTK_Surface%NumSectors = 25 + ! NOTE: we set p_FAST%VTK_Surface%GroundRad and p_FAST%VTK_Surface%HubRad in SetVTKParameters_B4HD + + ! write the ground or seabed reference polygon: - VTK_path = get_vtkroot_path( p_FAST%OutFileRoot ) RefPoint = p_FAST%TurbinePos if (p_FAST%CompHydro == MODULE_HD) then RefLengths = p_FAST%VTK_Surface%GroundRad*VTK_GroundFactor/2.0_SiKi ! note that p_FAST%TurbinePos(3) must be 0 for offshore turbines RefPoint(3) = p_FAST%TurbinePos(3) - InitOutData_HD%WtrDpth - call WrVTK_Ground ( RefPoint, RefLengths, trim(VTK_path) // '.SeabedSurface', ErrStat2, ErrMsg2 ) + call WrVTK_Ground ( RefPoint, RefLengths, trim(p_FAST%VTK_OutFileRoot) // '.SeabedSurface', ErrStat2, ErrMsg2 ) RefPoint(3) = p_FAST%TurbinePos(3) - InitOutData_HD%MSL2SWL - call WrVTK_Ground ( RefPoint, RefLengths, trim(VTK_path) // '.StillWaterSurface', ErrStat2, ErrMsg2 ) + call WrVTK_Ground ( RefPoint, RefLengths, trim(p_FAST%VTK_OutFileRoot) // '.StillWaterSurface', ErrStat2, ErrMsg2 ) else RefLengths = p_FAST%VTK_Surface%GroundRad !array = scalar - call WrVTK_Ground ( RefPoint, RefLengths, trim(VTK_path) // '.GroundSurface', ErrStat2, ErrMsg2 ) + call WrVTK_Ground ( RefPoint, RefLengths, trim(p_FAST%VTK_OutFileRoot) // '.GroundSurface', ErrStat2, ErrMsg2 ) end if @@ -3064,8 +3039,9 @@ SUBROUTINE SetVTKParameters(p_FAST, InitOutData_ED, InitOutData_AD, InitInData_H !........................................................................................................ ! we're going to create a box using these dimensions - y = ED%Output(1)%HubPtMotion%Position(3, 1) - ED%Output(1)%NacelleMotion%Position(3, 1) - x = TwoNorm( ED%Output(1)%HubPtMotion%Position(1:2,1) - ED%Output(1)%NacelleMotion%Position(1:2,1) ) - InitOutData_ED%HubRad + y = ED%y%HubPtMotion%Position(3, 1) - ED%y%NacelleMotion%Position(3, 1) + x = TwoNorm( ED%y%HubPtMotion%Position(1:2,1) - ED%y%NacelleMotion%Position(1:2,1) ) - p_FAST%VTK_Surface%HubRad + p_FAST%VTK_Surface%NacelleBox(:,1) = (/ -x, y, 0.0_SiKi /) p_FAST%VTK_Surface%NacelleBox(:,2) = (/ x, y, 0.0_SiKi /) @@ -3080,27 +3056,28 @@ SUBROUTINE SetVTKParameters(p_FAST, InitOutData_ED, InitOutData_AD, InitInData_H ! tapered tower !....................... - CALL AllocAry(p_FAST%VTK_Surface%TowerRad,ED%Output(1)%TowerLn2Mesh%NNodes,'VTK_Surface%TowerRad',ErrStat2,ErrMsg2) + CALL AllocAry(p_FAST%VTK_Surface%TowerRad,ED%y%TowerLn2Mesh%NNodes,'VTK_Surface%TowerRad',ErrStat2,ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF (ErrStat >= AbortErrLev) RETURN - - topNode = ED%Output(1)%TowerLn2Mesh%NNodes - 1 - baseNode = ED%Output(1)%TowerLn2Mesh%NNodes - TwrLength = TwoNorm( ED%Output(1)%TowerLn2Mesh%position(:,topNode) - ED%Output(1)%TowerLn2Mesh%position(:,baseNode) ) ! this is the assumed length of the tower + + topNode = ED%y%TowerLn2Mesh%NNodes - 1 + baseNode = ED%y%TowerLn2Mesh%refNode + TwrLength = TwoNorm( ED%y%TowerLn2Mesh%position(:,topNode) - ED%y%TowerLn2Mesh%position(:,baseNode) ) ! this is the assumed length of the tower TwrRatio = TwrLength / 87.6_SiKi ! use ratio of the tower length to the length of the 5MW tower TwrDiam_top = 3.87*TwrRatio TwrDiam_base = 6.0*TwrRatio TwrRatio = 0.5 * (TwrDiam_top - TwrDiam_base) / TwrLength - do k=1,ED%Output(1)%TowerLn2Mesh%NNodes - TwrLength = TwoNorm( ED%Output(1)%TowerLn2Mesh%position(:,k) - ED%Output(1)%TowerLn2Mesh%position(:,baseNode) ) + do k=1,ED%y%TowerLn2Mesh%NNodes + TwrLength = TwoNorm( ED%y%TowerLn2Mesh%position(:,k) - ED%y%TowerLn2Mesh%position(:,baseNode) ) p_FAST%VTK_Surface%TowerRad(k) = 0.5*TwrDiam_Base + TwrRatio*TwrLength end do + + !....................... ! blade surfaces !....................... - NumBl = SIZE(ED%Output(1)%BladeRootMotion,1) allocate(p_FAST%VTK_Surface%BladeShape(NumBl),stat=ErrStat2) if (errStat2/=0) then call setErrStat(ErrID_Fatal,'Error allocating VTK_Surface%BladeShape.',ErrStat,ErrMsg,RoutineName) @@ -3149,11 +3126,11 @@ SUBROUTINE SetVTKParameters(p_FAST, InitOutData_ED, InitOutData_AD, InitInData_H END DO ELSE DO K=1,NumBl - rootNode = ED%Output(1)%BladeLn2Mesh(K)%NNodes - tipNode = ED%Output(1)%BladeLn2Mesh(K)%NNodes-1 - cylNode = min(2,ED%Output(1)%BladeLn2Mesh(K)%NNodes) + rootNode = ED%y%BladeLn2Mesh(K)%NNodes + tipNode = ED%y%BladeLn2Mesh(K)%NNodes-1 + cylNode = min(2,ED%y%BladeLn2Mesh(K)%NNodes) - call SetVTKDefaultBladeParams(ED%Output(1)%BladeLn2Mesh(K), p_FAST%VTK_Surface%BladeShape(K), tipNode, rootNode, cylNode, ErrStat2, ErrMsg2) + call SetVTKDefaultBladeParams(ED%y%BladeLn2Mesh(K), p_FAST%VTK_Surface%BladeShape(K), tipNode, rootNode, cylNode, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF (ErrStat >= AbortErrLev) RETURN END DO @@ -3175,6 +3152,7 @@ SUBROUTINE SetVTKParameters(p_FAST, InitOutData_ED, InitOutData_AD, InitInData_H p_FAST%VTK_Surface%WaveElevXY(:,k) = p_FAST%VTK_Surface%WaveElevXY(:,k) + p_FAST%TurbinePos(1:2) end do + ! note that p_FAST%TurbinePos(3) must be 0 for offshore turbines !do k=1,size(p_FAST%VTK_Surface%WaveElev,2) ! p_FAST%VTK_Surface%WaveElev(:,k) = p_FAST%VTK_Surface%WaveElev(:,k) + p_FAST%TurbinePos(3) ! not sure this is really accurate if p_FAST%TurbinePos(3) is non-zero !end do @@ -3644,10 +3622,10 @@ SUBROUTINE FAST_WrSum( p_FAST, y_FAST, MeshMapData, ErrStat, ErrMsg ) WRITE (y_FAST%UnSum, Fmt ) y_FAST%Module_Ver(Module_Number)%Name, p_FAST%DT_module(Module_Number), p_FAST%n_substeps(Module_Number) END IF END DO - IF ( NINT( p_FAST%DT_out / p_FAST%DT ) == 1_IntKi ) THEN + IF ( p_FAST%n_DT_Out == 1_IntKi ) THEN WRITE (y_FAST%UnSum, Fmt ) "FAST output files", p_FAST%DT_out, 1_IntKi ! we'll write "1" instead of "1^-1" ELSE - WRITE (y_FAST%UnSum, Fmt ) "FAST output files", p_FAST%DT_out, NINT( p_FAST%DT_out / p_FAST%DT ),"^-1" + WRITE (y_FAST%UnSum, Fmt ) "FAST output files", p_FAST%DT_out, p_FAST%n_DT_Out,"^-1" END IF IF (p_FAST%WrVTK == VTK_Animate) THEN @@ -3659,16 +3637,17 @@ SUBROUTINE FAST_WrSum( p_FAST, y_FAST, MeshMapData, ErrStat, ErrMsg ) ELSE WRITE (y_FAST%UnSum, Fmt ) "VTK output files ", TmpRate, p_FAST%n_VTKTime,"^-1" END IF - + ELSE + TmpRate = p_FAST%VTK_fps + END IF + ! bjj: fix this; possibly add names of which files will be generated? - if (p_FAST%WrVTK == VTK_Animate) then - Fmt = '(2X,A17,2X,'//TRIM(p_FAST%OutFmt)//',:,T37,:,A)' + IF (p_FAST%WrVTK == VTK_Animate .or. p_FAST%WrVTK == VTK_ModeShapes) THEN + Fmt = '(2X,A17,2X,'//TRIM(p_FAST%OutFmt)//',:,T37,:,A)' - WRITE (y_FAST%UnSum,'(//,2X,A)') " Requested Visualization Output" - WRITE (y_FAST%UnSum, '(2X,A)') "-------------------------------------------------" - WRITE (y_FAST%UnSum, Fmt ) "Frame rate", 1.0_DbKi/TmpRate, " fps" - end if - + WRITE (y_FAST%UnSum,'(//,2X,A)') " Requested Visualization Output" + WRITE (y_FAST%UnSum, '(2X,A)') "-------------------------------------------------" + WRITE (y_FAST%UnSum, Fmt ) "Frame rate", 1.0_DbKi/TmpRate, " fps" END IF @@ -3759,6 +3738,8 @@ SUBROUTINE FAST_Solution0(p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, O ! local variables INTEGER(IntKi), PARAMETER :: n_t_global = -1 ! loop counter + INTEGER(IntKi), PARAMETER :: n_t_global_next = 0 ! loop counter + REAL(DbKi) :: t_initial ! next simulation time (t_global_next) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -3770,8 +3751,11 @@ SUBROUTINE FAST_Solution0(p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, O ErrStat = ErrID_None ErrMsg = "" + t_initial = m_FAST%t_global ! which is used in place of t_global_next + y_FAST%WriteThisStep = NeedWriteOutput(n_t_global_next, t_initial, p_FAST) + IF (p_FAST%WrSttsTime) then - CALL SimStatus_FirstTime( m_FAST%TiLstPrn, m_FAST%PrevClockTime, m_FAST%SimStrtTime, m_FAST%UsrTime2, m_FAST%t_global, p_FAST%TMax, p_FAST%TDesc ) + CALL SimStatus_FirstTime( m_FAST%TiLstPrn, m_FAST%PrevClockTime, m_FAST%SimStrtTime, m_FAST%UsrTime2, t_initial, p_FAST%TMax, p_FAST%TDesc ) END IF @@ -3780,10 +3764,10 @@ SUBROUTINE FAST_Solution0(p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, O ! the initial ServoDyn and IfW/Lidar inputs from Simulink: IF ( p_FAST%CompServo == Module_SrvD ) CALL SrvD_SetExternalInputs( p_FAST, m_FAST, SrvD%Input(1) ) - IF ( p_FAST%CompInflow == Module_IfW ) CALL IfW_SetExternalInputs( IfW%p, m_FAST, ED%Output(1), IfW%Input(1) ) + IF ( p_FAST%CompInflow == Module_IfW ) CALL IfW_SetExternalInputs( IfW%p, m_FAST, ED%y, IfW%Input(1) ) - CALL CalcOutputs_And_SolveForInputs( n_t_global, m_FAST%t_global, STATE_CURR, m_FAST%calcJacobian, m_FAST%NextJacCalcTime, & - p_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, & + CALL CalcOutputs_And_SolveForInputs( n_t_global, t_initial, STATE_CURR, m_FAST%calcJacobian, m_FAST%NextJacCalcTime, & + p_FAST, m_FAST, y_FAST%WriteThisStep, ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, & MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -3792,29 +3776,14 @@ SUBROUTINE FAST_Solution0(p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, O ! Check to see if we should output data this time step: !---------------------------------------------------------------------------------------- - CALL WriteOutputToFile(0, m_FAST%t_global, p_FAST, y_FAST, ED, BD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2) + CALL WriteOutputToFile(n_t_global_next, t_initial, p_FAST, y_FAST, ED, BD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! turn off VTK output when if (p_FAST%WrVTK == VTK_InitOnly) then ! Write visualization data for initialization (and also note that we're ignoring any errors that occur doing so) - IF ( p_FAST%VTK_Type == VTK_Surf ) THEN - CALL WrVTK_Surfaces(m_FAST%t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD14, AD, IfW, OpFM, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) - ELSE IF ( p_FAST%VTK_Type == VTK_Basic ) THEN - CALL WrVTK_BasicMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD14, AD, IfW, OpFM, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) - ELSE IF ( p_FAST%VTK_Type == VTK_All ) THEN - CALL WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) - ELSE IF (p_FAST%VTK_Type==VTK_Old) THEN - CALL WriteInputMeshesToFile( ED%Input(1), AD%Input(1), SD%Input(1), HD%Input(1), MAPp%Input(1), BD%Input(1,:), TRIM(p_FAST%OutFileRoot)//'.InputMeshes.bin', ErrStat2, ErrMsg2) - !unOut = -1 - !CALL MeshWrBin ( unOut, AD%y%BladeLoad(2), ErrStat2, ErrMsg2, 'AD_2_ED_loads.bin'); IF (ErrStat2 /= ErrID_None) CALL WrScr(TRIM(ErrMsg2)) - !CALL MeshWrBin ( unOut, ED%Input(1)%BladePtLoads(2),ErrStat2, ErrMsg2, 'AD_2_ED_loads.bin'); IF (ErrStat2 /= ErrID_None) CALL WrScr(TRIM(ErrMsg2)) - !CALL MeshMapWrBin( unOut, AD%y%BladeLoad(2), ED%Input(1)%BladePtLoads(2), MeshMapData%AD_L_2_BDED_B(2), ErrStat2, ErrMsg2, 'AD_2_ED_loads.bin' ); IF (ErrStat2 /= ErrID_None) CALL WrScr(TRIM(ErrMsg2)) - !close( unOut ) - END IF - - y_FAST%VTK_count = y_FAST%VTK_count + 1 + call WriteVTK(t_initial, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) end if @@ -3878,6 +3847,7 @@ SUBROUTINE FAST_InitIOarrays( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, A ! for the first and second time steps. (The interpolation order in the ExtrapInput routines are determined as ! order = SIZE(ED%Input) + DO j = 1, p_FAST%InterpOrder + 1 ED%InputTimes(j) = t_initial - (j - 1) * p_FAST%dt !ED_OutputTimes(j) = t_initial - (j - 1) * dt @@ -3886,16 +3856,10 @@ SUBROUTINE FAST_InitIOarrays( t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, A DO j = 2, p_FAST%InterpOrder + 1 CALL ED_CopyInput (ED%Input(1), ED%Input(j), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - - CALL ED_CopyOutput (ED%Output(1), ED%Output(j), MESH_NEWCOPY, Errstat2, ErrMsg2) !BJJ: THIS IS REALLY ONLY NECESSARY FOR ED-HD COUPLING AT THE MOMENT - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END DO CALL ED_CopyInput (ED%Input(1), ED%u, MESH_NEWCOPY, Errstat2, ErrMsg2) ! do this to initialize meshes/allocatable arrays for output of ExtrapInterp routine CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - CALL ED_CopyOutput (ED%Output(1), ED%y, MESH_NEWCOPY, Errstat2, ErrMsg2) ! do this to initialize meshes/allocatable arrays for output of ExtrapInterp routine - CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - ! Initialize predicted states for j_pc loop: CALL ED_CopyContState (ED%x( STATE_CURR), ED%x( STATE_PRED), MESH_NEWCOPY, Errstat2, ErrMsg2) CALL SetErrStat( Errstat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -4347,10 +4311,15 @@ SUBROUTINE FAST_Solution(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, ! local variables REAL(DbKi) :: t_global_next ! next simulation time (m_FAST%t_global + p_FAST%dt) + INTEGER(IntKi) :: n_t_global_next ! n_t_global + 1 INTEGER(IntKi) :: j_pc ! predictor-corrector loop counter INTEGER(IntKi) :: NumCorrections ! number of corrections for this time step + INTEGER(IntKi), parameter :: MaxCorrections = 20 ! maximum number of corrections allowed + LOGICAL :: WriteThisStep ! Whether WriteOutput values will be printed INTEGER(IntKi) :: I, k ! generic loop counters + + !REAL(ReKi) :: ControlInputGuess ! value of controller inputs INTEGER(IntKi) :: ErrStat2 @@ -4361,8 +4330,11 @@ SUBROUTINE FAST_Solution(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, ErrStat = ErrID_None ErrMsg = "" - t_global_next = t_initial + (n_t_global+1)*p_FAST%DT ! = m_FAST%t_global + p_FAST%dt - + n_t_global_next = n_t_global+1 + t_global_next = t_initial + n_t_global_next*p_FAST%DT ! = m_FAST%t_global + p_FAST%dt + + y_FAST%WriteThisStep = NeedWriteOutput(n_t_global_next, t_global_next, p_FAST) + !! determine if the Jacobian should be calculated this time IF ( m_FAST%calcJacobian ) THEN ! this was true (possibly at initialization), so we'll advance the time for the next calculation of the Jacobian @@ -4396,13 +4368,16 @@ SUBROUTINE FAST_Solution(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, !! !! gives predicted values at t+dt !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - CALL FAST_ExtrapInterpMods( t_global_next, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, HD, SD, ExtPtfm, & + CALL FAST_ExtrapInterpMods( t_global_next, p_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, HD, SD, ExtPtfm, & MAPp, FEAM, MD, Orca, IceF, IceD, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) !! predictor-corrector loop: - DO j_pc = 0, NumCorrections + j_pc = 0 + do while (j_pc <= NumCorrections) + WriteThisStep = y_FAST%WriteThisStep .AND. j_pc==NumCorrections + !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !! ## Step 1.b: Advance states (yield state and constraint values at t_global_next) !! @@ -4410,24 +4385,44 @@ SUBROUTINE FAST_Solution(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, !! STATE_PRED values contain values at t_global_next. !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - CALL FAST_AdvanceStates( t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, & - MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) + CALL FAST_AdvanceStates( t_initial, n_t_global, p_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, & + MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2, WriteThisStep ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (ErrStat >= AbortErrLev) RETURN !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !! ## Step 1.c: Input-Output Solve !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - + ! save predicted inputs for comparison with corrected value later + !IF (p_FAST%CheckHSSBrTrqC) THEN + ! ControlInputGuess = ED%Input(1)%HSSBrTrqC + !END IF + CALL CalcOutputs_And_SolveForInputs( n_t_global, t_global_next, STATE_PRED, m_FAST%calcJacobian, m_FAST%NextJacCalcTime, & - p_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) + p_FAST, m_FAST, WriteThisStep, ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (ErrStat >= AbortErrLev) RETURN !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ !! ## Step 2: Correct (continue in loop) !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ - + j_pc = j_pc + 1 + + ! ! Check if the predicted inputs were significantly different than the corrected inputs + ! ! (values before and after CalcOutputs_And_SolveForInputs) + !if (j_pc > NumCorrections) then + ! + ! !if (p_FAST%CheckHSSBrTrqC) then + ! ! if ( abs(ControlInputGuess - ED%Input(1)%HSSBrTrqC) > 50.0_ReKi ) then ! I randomly picked 50 N-m + ! ! NumCorrections = min(p_FAST%NumCrctn + 1, MaxCorrections) + ! ! ! print *, 'correction:', t_global_next, NumCorrections + ! ! cycle + ! ! end if + ! !end if + ! + ! ! check pitch position input to structural code (not implemented, yet) + !end if + enddo ! j_pc !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ @@ -4623,7 +4618,7 @@ SUBROUTINE FAST_Solution(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, !! Check to see if we should output data this time step: !---------------------------------------------------------------------------------------- - CALL WriteOutputToFile(n_t_global+1, m_FAST%t_global, p_FAST, y_FAST, ED, BD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, & + CALL WriteOutputToFile(n_t_global_next, t_global_next, p_FAST, y_FAST, ED, BD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, & SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -4632,8 +4627,9 @@ SUBROUTINE FAST_Solution(t_initial, n_t_global, p_FAST, y_FAST, m_FAST, ED, BD, !---------------------------------------------------------------------------------------- IF (p_FAST%WrSttsTime) then - IF ( MOD( n_t_global + 1, p_FAST%n_SttsTime ) == 0 ) THEN - CALL SimStatus( m_FAST%TiLstPrn, m_FAST%PrevClockTime, m_FAST%t_global, p_FAST%TMax, p_FAST%TDesc ) + IF ( MOD( n_t_global_next, p_FAST%n_SttsTime ) == 0 ) THEN + CALL SimStatus( m_FAST%TiLstPrn, m_FAST%PrevClockTime, m_FAST%t_global, p_FAST%TMax, p_FAST%TDesc ) + ENDIF ENDIF @@ -4641,8 +4637,24 @@ END SUBROUTINE FAST_Solution !---------------------------------------------------------------------------------------------------------------------------------- ! ROUTINES TO OUTPUT WRITE DATA TO FILE AT EACH REQUSTED TIME STEP !---------------------------------------------------------------------------------------------------------------------------------- -!> This routine determines if it's time to write to the output files, and calls the routine to write to the files -!! with the output data. It should be called after all the output solves for a given time have been completed. +FUNCTION NeedWriteOutput(n_t_global, t_global, p_FAST) + INTEGER(IntKi), INTENT(IN ) :: n_t_global !< Current global time step + REAL(DbKi), INTENT(IN ) :: t_global !< Current global time + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + + LOGICAL :: NeedWriteOutput !< Function result; if true, WriteOutput values are needed on this time step + + IF ( t_global >= p_FAST%TStart ) THEN ! note that if TStart isn't an multiple of DT_out, we will not necessarially start output to the file at TStart + NeedWriteOutput = MOD( n_t_global, p_FAST%n_DT_Out ) == 0 + ELSE + NeedWriteOutput = .FALSE. + END IF + +END FUNCTION NeedWriteOutput +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine determines if it's time to write to the output files--based on a previous call to fast_subs::needwriteoutput--, and +!! calls the routine to write to the files with the output data. It should be called after all the output solves for a given time +!! have been completed, and assumes y_FAST\%WriteThisStep has been set. SUBROUTINE WriteOutputToFile(n_t_global, t_global, p_FAST, y_FAST, ED, BD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, & SrvD, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat, ErrMsg) !............................................................................................................................... @@ -4673,9 +4685,6 @@ SUBROUTINE WriteOutputToFile(n_t_global, t_global, p_FAST, y_FAST, ED, BD, AD14, CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None - REAL(DbKi) :: OutTime ! Used to determine if output should be generated at this simulation time - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMSg2 CHARACTER(*), PARAMETER :: RoutineName = 'WriteOutputToFile' ErrStat = ErrID_None @@ -4683,43 +4692,26 @@ SUBROUTINE WriteOutputToFile(n_t_global, t_global, p_FAST, y_FAST, ED, BD, AD14, ! Write time-series channel data - IF ( t_global >= p_FAST%TStart ) THEN + !y_FAST%WriteThisStep = NeedWriteOutput(n_t_global, t_global, p_FAST) + IF ( y_FAST%WriteThisStep ) THEN - !bjj FIX THIS algorithm!!! this assumes dt_out is an integer multiple of dt; we will probably have to do some interpolation to get these outputs at the times we want them.... - !bjj: perhaps we should do this with integer math on n_t_global now... - OutTime = NINT( t_global / p_FAST%DT_out ) * p_FAST%DT_out - IF ( EqualRealNos( t_global, OutTime ) ) THEN + ! Generate glue-code output file - ! Generate glue-code output file - - CALL WrOutputLine( t_global, p_FAST, y_FAST, IfW%y%WriteOutput, OpFM%y%WriteOutput, ED%Output(1)%WriteOutput, & - AD%y%WriteOutput, SrvD%y%WriteOutput, HD%y%WriteOutput, SD%y%WriteOutput, ExtPtfm%y%WriteOutput, MAPp%y%WriteOutput, & - FEAM%y%WriteOutput, MD%y%WriteOutput, Orca%y%WriteOutput, IceF%y%WriteOutput, IceD%y, BD%y, ErrStat, ErrMsg ) - - END IF + CALL WrOutputLine( t_global, p_FAST, y_FAST, IfW%y%WriteOutput, OpFM%y%WriteOutput, ED%y%WriteOutput, & + AD%y%WriteOutput, SrvD%y%WriteOutput, HD%y%WriteOutput, SD%y%WriteOutput, ExtPtfm%y%WriteOutput, MAPp%y%WriteOutput, & + FEAM%y%WriteOutput, MD%y%WriteOutput, Orca%y%WriteOutput, IceF%y%WriteOutput, IceD%y, BD%y, ErrStat, ErrMsg ) ENDIF ! Write visualization data (and also note that we're ignoring any errors that occur doing so) IF ( p_FAST%WrVTK == VTK_Animate ) THEN IF ( MOD( n_t_global, p_FAST%n_VTKTime ) == 0 ) THEN - - IF ( p_FAST%VTK_Type == VTK_Surf ) THEN - CALL WrVTK_Surfaces(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD14, AD, IfW, OpFM, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) - ELSE IF ( p_FAST%VTK_Type == VTK_Basic ) THEN - CALL WrVTK_BasicMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD14, AD, IfW, OpFM, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) - ELSE IF ( p_FAST%VTK_Type == VTK_All ) THEN - CALL WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) - ELSE IF (p_FAST%VTK_Type==VTK_Old) THEN - CALL WriteMotionMeshesToFile(t_global, ED%Output(1), SD%Input(1), SD%y, HD%Input(1), MAPp%Input(1), BD%y, BD%Input(1,:), y_FAST%UnGra, ErrStat2, ErrMsg2, TRIM(p_FAST%OutFileRoot)//'.gra') - END IF - - y_FAST%VTK_count = y_FAST%VTK_count + 1 + call WriteVTK(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) END IF END IF -END SUBROUTINE WriteOutputToFile +END SUBROUTINE WriteOutputToFile !---------------------------------------------------------------------------------------------------------------------------------- !> This routine writes the module output to the primary output file(s). SUBROUTINE WrOutputLine( t, p_FAST, y_FAST, IfWOutput, OpFMOutput, EDOutput, ADOutput, SrvDOutput, HDOutput, SDOutput, ExtPtfmOutput,& @@ -4822,7 +4814,7 @@ SUBROUTINE FillOutputAry_T(Turbine, Outputs) CALL FillOutputAry(Turbine%p_FAST, Turbine%y_FAST, Turbine%IfW%y%WriteOutput, Turbine%OpFM%y%WriteOutput, & - Turbine%ED%Output(1)%WriteOutput, Turbine%AD%y%WriteOutput, Turbine%SrvD%y%WriteOutput, & + Turbine%ED%y%WriteOutput, Turbine%AD%y%WriteOutput, Turbine%SrvD%y%WriteOutput, & Turbine%HD%y%WriteOutput, Turbine%SD%y%WriteOutput, Turbine%ExtPtfm%y%WriteOutput, Turbine%MAP%y%WriteOutput, & Turbine%FEAM%y%WriteOutput, Turbine%MD%y%WriteOutput, Turbine%Orca%y%WriteOutput, & Turbine%IceF%y%WriteOutput, Turbine%IceD%y, Turbine%BD%y, Outputs) @@ -4949,8 +4941,56 @@ SUBROUTINE FillOutputAry(p_FAST, y_FAST, IfWOutput, OpFMOutput, EDOutput, ADOutp END SUBROUTINE FillOutputAry !---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE WriteVTK(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) + REAL(DbKi), INTENT(IN ) :: t_global !< Current global time + TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code (only because we're updating VTK_LastWaveIndx) + TYPE(FAST_ModuleMapType), INTENT(IN ) :: MeshMapData !< Data for mapping between modules + + TYPE(ElastoDyn_Data), INTENT(IN ) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(IN ) :: BD !< BeamDyn data + TYPE(ServoDyn_Data), INTENT(IN ) :: SrvD !< ServoDyn data + TYPE(AeroDyn_Data), INTENT(IN ) :: AD !< AeroDyn data + TYPE(InflowWind_Data), INTENT(IN ) :: IfW !< InflowWind data + TYPE(OpenFOAM_Data), INTENT(IN ) :: OpFM !< OpenFOAM data + TYPE(HydroDyn_Data), INTENT(IN ) :: HD !< HydroDyn data + TYPE(SubDyn_Data), INTENT(IN ) :: SD !< SubDyn data + TYPE(ExtPtfm_Data), INTENT(IN ) :: ExtPtfm !< ExtPtfm_MCKF data + TYPE(MAP_Data), INTENT(IN ) :: MAPp !< MAP data + TYPE(FEAMooring_Data), INTENT(IN ) :: FEAM !< FEAMooring data + TYPE(MoorDyn_Data), INTENT(IN ) :: MD !< MoorDyn data + TYPE(OrcaFlex_Data), INTENT(IN ) :: Orca !< OrcaFlex interface data + TYPE(IceFloe_Data), INTENT(IN ) :: IceF !< IceFloe data + TYPE(IceDyn_Data), INTENT(IN ) :: IceD !< All the IceDyn data used in time-step loop + + + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMSg2 + CHARACTER(*), PARAMETER :: RoutineName = 'WriteVTK' + + + IF ( p_FAST%VTK_Type == VTK_Surf ) THEN + CALL WrVTK_Surfaces(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) + ELSE IF ( p_FAST%VTK_Type == VTK_Basic ) THEN + CALL WrVTK_BasicMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) + ELSE IF ( p_FAST%VTK_Type == VTK_All ) THEN + CALL WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) + ELSE IF (p_FAST%VTK_Type==VTK_Old) THEN + CALL WriteInputMeshesToFile( ED%Input(1), AD%Input(1), SD%Input(1), HD%Input(1), MAPp%Input(1), BD%Input(1,:), TRIM(p_FAST%OutFileRoot)//'.InputMeshes.bin', ErrStat2, ErrMsg2) + CALL WriteMotionMeshesToFile(t_global, ED%y, SD%Input(1), SD%y, HD%Input(1), MAPp%Input(1), BD%y, BD%Input(1,:), y_FAST%UnGra, ErrStat2, ErrMsg2, TRIM(p_FAST%OutFileRoot)//'.gra') + !unOut = -1 + !CALL MeshWrBin ( unOut, AD%y%BladeLoad(2), ErrStat2, ErrMsg2, 'AD_2_ED_loads.bin'); IF (ErrStat2 /= ErrID_None) CALL WrScr(TRIM(ErrMsg2)) + !CALL MeshWrBin ( unOut, ED%Input(1)%BladePtLoads(2),ErrStat2, ErrMsg2, 'AD_2_ED_loads.bin'); IF (ErrStat2 /= ErrID_None) CALL WrScr(TRIM(ErrMsg2)) + !CALL MeshMapWrBin( unOut, AD%y%BladeLoad(2), ED%Input(1)%BladePtLoads(2), MeshMapData%AD_L_2_BDED_B(2), ErrStat2, ErrMsg2, 'AD_2_ED_loads.bin' ); IF (ErrStat2 /= ErrID_None) CALL WrScr(TRIM(ErrMsg2)) + !close( unOut ) + END IF + + y_FAST%VTK_count = y_FAST%VTK_count + 1 + +END SUBROUTINE WriteVTK +!---------------------------------------------------------------------------------------------------------------------------------- !> This routine writes all the committed meshes to VTK-formatted files. It doesn't bother with returning an error code. -SUBROUTINE WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) +SUBROUTINE WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code TYPE(FAST_OutputFileType),INTENT(IN ) :: y_FAST !< Output variables for the glue code @@ -4959,7 +4999,6 @@ SUBROUTINE WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD14, AD, IfW, O TYPE(ElastoDyn_Data), INTENT(IN ) :: ED !< ElastoDyn data TYPE(BeamDyn_Data), INTENT(IN ) :: BD !< BeamDyn data TYPE(ServoDyn_Data), INTENT(IN ) :: SrvD !< ServoDyn data - TYPE(AeroDyn14_Data), INTENT(IN ) :: AD14 !< AeroDyn14 data TYPE(AeroDyn_Data), INTENT(IN ) :: AD !< AeroDyn data TYPE(InflowWind_Data), INTENT(IN ) :: IfW !< InflowWind data TYPE(OpenFOAM_Data), INTENT(IN ) :: OpFM !< OpenFOAM data @@ -4975,54 +5014,45 @@ SUBROUTINE WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD14, AD, IfW, O logical :: outputFields ! flag to determine if we want to output the HD mesh fields - INTEGER(IntKi) :: NumBl, k, Twidth - CHARACTER(1024) :: VTK_path + INTEGER(IntKi) :: NumBl, k + INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMSg2 CHARACTER(*), PARAMETER :: RoutineName = 'WrVTK_AllMeshes' - ! Calculate the number of digits for the maximum number of output steps to be written. - ! This will be used to pad the write-out step in the VTK filename with zeros in calls to MeshWrVTK() - if ( (p_FAST%n_VTKTime>0) .and. (p_FAST%n_TMax_m1+1>0) ) then - Twidth = CEILING( log10( real(p_FAST%n_TMax_m1+1, ReKi) / p_FAST%n_VTKTime ) ) + 1 - else - Twidth = 1 - endif + NumBl = 0 - if (allocated(ED%Output)) then - if (allocated(ED%Output(1)%BladeRootMotion)) then - NumBl = SIZE(ED%Output(1)%BladeRootMotion) - end if + if (allocated(ED%y%BladeRootMotion)) then + NumBl = SIZE(ED%y%BladeRootMotion) end if - - VTK_path = get_vtkroot_path( p_FAST%OutFileRoot ) + ! I'm first going to just put all of the meshes that get mapped together, then decide if we're going to print/plot them all ! ElastoDyn - if (allocated(ED%Output) .and. allocated(ED%Input)) then + if (allocated(ED%Input)) then ! ElastoDyn outputs (motions) DO K=1,NumBl !%BladeLn2Mesh(K) used only when not BD (see below) - call MeshWrVTK(p_FAST%TurbinePos, ED%Output(1)%BladeRootMotion(K), trim(VTK_path)//'.ED_BladeRootMotion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth ) + call MeshWrVTK(p_FAST%TurbinePos, ED%y%BladeRootMotion(K), trim(p_FAST%VTK_OutFileRoot)//'.ED_BladeRootMotion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) END DO - call MeshWrVTK(p_FAST%TurbinePos, ED%Output(1)%TowerLn2Mesh, trim(VTK_path)//'.ED_TowerLn2Mesh_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth ) + call MeshWrVTK(p_FAST%TurbinePos, ED%y%TowerLn2Mesh, trim(p_FAST%VTK_OutFileRoot)//'.ED_TowerLn2Mesh_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) ! these will get output with their sibling input meshes - !call MeshWrVTK(p_FAST%TurbinePos, ED%Output(1)%HubPtMotion, trim(p_FAST%OutFileRoot)//'.ED_HubPtMotion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) - !call MeshWrVTK(p_FAST%TurbinePos, ED%Output(1)%NacelleMotion, trim(p_FAST%OutFileRoot)//'.ED_NacelleMotion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) - !call MeshWrVTK(p_FAST%TurbinePos, ED%Output(1)%PlatformPtMesh, trim(p_FAST%OutFileRoot)//'.ED_PlatformPtMesh_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) + !call MeshWrVTK(p_FAST%TurbinePos, ED%y%HubPtMotion, trim(p_FAST%VTK_OutFileRoot)//'.ED_HubPtMotion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + !call MeshWrVTK(p_FAST%TurbinePos, ED%y%NacelleMotion, trim(p_FAST%VTK_OutFileRoot)//'.ED_NacelleMotion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + !call MeshWrVTK(p_FAST%TurbinePos, ED%y%PlatformPtMesh, trim(p_FAST%VTK_OutFileRoot)//'.ED_PlatformPtMesh_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) ! ElastoDyn inputs (loads) ! %BladePtLoads used only when not BD (see below) - call MeshWrVTK(p_FAST%TurbinePos, ED%Input(1)%TowerPtLoads, trim(VTK_path)//'.ED_TowerPtLoads', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, ED%Output(1)%TowerLn2Mesh ) - call MeshWrVTK(p_FAST%TurbinePos, ED%Input(1)%HubPtLoad, trim(VTK_path)//'.ED_Hub', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, ED%Output(1)%HubPtMotion ) - call MeshWrVTK(p_FAST%TurbinePos, ED%Input(1)%NacelleLoads, trim(VTK_path)//'.ED_Nacelle' ,y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, ED%Output(1)%NacelleMotion ) - call MeshWrVTK(p_FAST%TurbinePos, ED%Input(1)%PlatformPtMesh, trim(VTK_path)//'.ED_PlatformPtMesh', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, ED%Output(1)%PlatformPtMesh ) + call MeshWrVTK(p_FAST%TurbinePos, ED%Input(1)%TowerPtLoads, trim(p_FAST%VTK_OutFileRoot)//'.ED_TowerPtLoads', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, ED%y%TowerLn2Mesh ) + call MeshWrVTK(p_FAST%TurbinePos, ED%Input(1)%HubPtLoad, trim(p_FAST%VTK_OutFileRoot)//'.ED_Hub', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, ED%y%HubPtMotion ) + call MeshWrVTK(p_FAST%TurbinePos, ED%Input(1)%NacelleLoads, trim(p_FAST%VTK_OutFileRoot)//'.ED_Nacelle' ,y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, ED%y%NacelleMotion ) + call MeshWrVTK(p_FAST%TurbinePos, ED%Input(1)%PlatformPtMesh, trim(p_FAST%VTK_OutFileRoot)//'.ED_PlatformPtMesh', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, ED%y%PlatformPtMesh ) end if @@ -5031,51 +5061,51 @@ SUBROUTINE WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD14, AD, IfW, O do K=1,NumBl ! BeamDyn inputs - !call MeshWrVTK(p_FAST%TurbinePos, BD%Input(1,k)%RootMotion, trim(p_FAST%OutFileRoot)//'.BD_RootMotion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) - call MeshWrVTK(p_FAST%TurbinePos, BD%Input(1,k)%HubMotion, trim(VTK_path)//'.BD_HubMotion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth ) + !call MeshWrVTK(p_FAST%TurbinePos, BD%Input(1,k)%RootMotion, trim(p_FAST%VTK_OutFileRoot)//'.BD_RootMotion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + call MeshWrVTK(p_FAST%TurbinePos, BD%Input(1,k)%HubMotion, trim(p_FAST%VTK_OutFileRoot)//'.BD_HubMotion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) end do if (allocated(MeshMapData%y_BD_BldMotion_4Loads)) then do K=1,NumBl - call MeshWrVTK(p_FAST%TurbinePos, BD%Input(1,k)%DistrLoad, trim(VTK_path)//'.BD_DistrLoad'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, MeshMapData%y_BD_BldMotion_4Loads(k) ) + call MeshWrVTK(p_FAST%TurbinePos, BD%Input(1,k)%DistrLoad, trim(p_FAST%VTK_OutFileRoot)//'.BD_DistrLoad'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, MeshMapData%y_BD_BldMotion_4Loads(k) ) ! skipping PointLoad end do elseif (p_FAST%BD_OutputSibling) then do K=1,NumBl - call MeshWrVTK(p_FAST%TurbinePos, BD%Input(1,k)%DistrLoad, trim(p_FAST%OutFileRoot)//'.BD_Blade'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, BD%y(k)%BldMotion ) + call MeshWrVTK(p_FAST%TurbinePos, BD%Input(1,k)%DistrLoad, trim(p_FAST%VTK_OutFileRoot)//'.BD_Blade'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, BD%y(k)%BldMotion ) ! skipping PointLoad end do end if do K=1,NumBl ! BeamDyn outputs - call MeshWrVTK(p_FAST%TurbinePos, BD%y(k)%ReactionForce, trim(p_FAST%OutFileRoot)//'.BD_ReactionForce_RootMotion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, BD%Input(1,k)%RootMotion ) + call MeshWrVTK(p_FAST%TurbinePos, BD%y(k)%ReactionForce, trim(p_FAST%VTK_OutFileRoot)//'.BD_ReactionForce_RootMotion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, BD%Input(1,k)%RootMotion ) end do if (.not. p_FAST%BD_OutputSibling) then !otherwise this mesh has been put with the DistrLoad mesh do K=1,NumBl ! BeamDyn outputs - call MeshWrVTK(p_FAST%TurbinePos, BD%y(k)%BldMotion, trim(p_FAST%OutFileRoot)//'.BD_BldMotion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth ) + call MeshWrVTK(p_FAST%TurbinePos, BD%y(k)%BldMotion, trim(p_FAST%VTK_OutFileRoot)//'.BD_BldMotion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) end do end if - ELSE if (allocated(ED%Input) .and. allocated(ED%Output)) then + ELSE if (p_FAST%CompElast == Module_ED .and. allocated(ED%Input)) then ! ElastoDyn DO K=1,NumBl - call MeshWrVTK(p_FAST%TurbinePos, ED%Output(1)%BladeLn2Mesh(K), trim(VTK_path)//'.ED_BladeLn2Mesh_motion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth ) - call MeshWrVTK(p_FAST%TurbinePos, ED%Input(1)%BladePtLoads(K), trim(VTK_path)//'.ED_BladePtLoads'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, ED%Output(1)%BladeLn2Mesh(K) ) + call MeshWrVTK(p_FAST%TurbinePos, ED%y%BladeLn2Mesh(K), trim(p_FAST%VTK_OutFileRoot)//'.ED_BladeLn2Mesh_motion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + call MeshWrVTK(p_FAST%TurbinePos, ED%Input(1)%BladePtLoads(K), trim(p_FAST%VTK_OutFileRoot)//'.ED_BladePtLoads'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, ED%y%BladeLn2Mesh(K) ) END DO END IF ! ServoDyn if (allocated(SrvD%Input)) then IF ( SrvD%Input(1)%NTMD%Mesh%Committed ) THEN - !call MeshWrVTK(p_FAST%TurbinePos, SrvD%Input(1)%NTMD%Mesh, trim(p_FAST%OutFileRoot)//'.SrvD_NTMD_Motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) - call MeshWrVTK(p_FAST%TurbinePos, SrvD%y%NTMD%Mesh, trim(VTK_path)//'.SrvD_NTMD', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, SrvD%Input(1)%TTMD%Mesh ) + !call MeshWrVTK(p_FAST%TurbinePos, SrvD%Input(1)%NTMD%Mesh, trim(p_FAST%VTK_OutFileRoot)//'.SrvD_NTMD_Motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + call MeshWrVTK(p_FAST%TurbinePos, SrvD%y%NTMD%Mesh, trim(p_FAST%VTK_OutFileRoot)//'.SrvD_NTMD', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, SrvD%Input(1)%TTMD%Mesh ) END IF IF ( SrvD%Input(1)%TTMD%Mesh%Committed ) THEN - !call MeshWrVTK(p_FAST%TurbinePos, SrvD%Input(1)%TTMD%Mesh, trim(p_FAST%OutFileRoot)//'.SrvD_TTMD_Motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) - call MeshWrVTK(p_FAST%TurbinePos, SrvD%y%TTMD%Mesh, trim(VTK_path)//'.SrvD_TTMD', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, SrvD%Input(1)%TTMD%Mesh ) + !call MeshWrVTK(p_FAST%TurbinePos, SrvD%Input(1)%TTMD%Mesh, trim(p_FAST%VTK_OutFileRoot)//'.SrvD_TTMD_Motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + call MeshWrVTK(p_FAST%TurbinePos, SrvD%y%TTMD%Mesh, trim(p_FAST%VTK_OutFileRoot)//'.SrvD_TTMD', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, SrvD%Input(1)%TTMD%Mesh ) END IF end if @@ -5086,16 +5116,16 @@ SUBROUTINE WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD14, AD, IfW, O if (allocated(AD%Input(1)%BladeRootMotion)) then DO K=1,NumBl - call MeshWrVTK(p_FAST%TurbinePos, AD%Input(1)%BladeRootMotion(K), trim(VTK_path)//'.AD_BladeRootMotion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth ) - !call MeshWrVTK(p_FAST%TurbinePos, AD%Input(1)%BladeMotion(K), trim(p_FAST%OutFileRoot)//'.AD_BladeMotion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) + call MeshWrVTK(p_FAST%TurbinePos, AD%Input(1)%BladeRootMotion(K), trim(p_FAST%VTK_OutFileRoot)//'.AD_BladeRootMotion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + !call MeshWrVTK(p_FAST%TurbinePos, AD%Input(1)%BladeMotion(K), trim(p_FAST%VTK_OutFileRoot)//'.AD_BladeMotion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) END DO - call MeshWrVTK(p_FAST%TurbinePos, AD%Input(1)%HubMotion, trim(VTK_path)//'.AD_HubMotion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth ) - !call MeshWrVTK(p_FAST%TurbinePos, AD%Input(1)%TowerMotion, trim(p_FAST%OutFileRoot)//'.AD_TowerMotion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) + call MeshWrVTK(p_FAST%TurbinePos, AD%Input(1)%HubMotion, trim(p_FAST%VTK_OutFileRoot)//'.AD_HubMotion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + !call MeshWrVTK(p_FAST%TurbinePos, AD%Input(1)%TowerMotion, trim(p_FAST%VTK_OutFileRoot)//'.AD_TowerMotion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) DO K=1,NumBl - call MeshWrVTK(p_FAST%TurbinePos, AD%y%BladeLoad(K), trim(VTK_path)//'.AD_Blade'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, AD%Input(1)%BladeMotion(k) ) + call MeshWrVTK(p_FAST%TurbinePos, AD%y%BladeLoad(K), trim(p_FAST%VTK_OutFileRoot)//'.AD_Blade'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, AD%Input(1)%BladeMotion(k) ) END DO - call MeshWrVTK(p_FAST%TurbinePos, AD%y%TowerLoad, trim(VTK_path)//'.AD_Tower', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, AD%Input(1)%TowerMotion ) + call MeshWrVTK(p_FAST%TurbinePos, AD%y%TowerLoad, trim(p_FAST%VTK_OutFileRoot)//'.AD_Tower', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, AD%Input(1)%TowerMotion ) end if @@ -5103,60 +5133,60 @@ SUBROUTINE WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD14, AD, IfW, O ! HydroDyn IF ( p_FAST%CompHydro == Module_HD .and. allocated(HD%Input)) THEN - !call MeshWrVTK(p_FAST%TurbinePos, HD%Input(1)%Mesh, trim(p_FAST%OutFileRoot)//'.HD_Mesh_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) - !call MeshWrVTK(p_FAST%TurbinePos, HD%Input(1)%Morison%LumpedMesh, trim(p_FAST%OutFileRoot)//'.HD_MorisonLumped_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) - !call MeshWrVTK(p_FAST%TurbinePos, HD%Input(1)%Morison%DistribMesh, trim(p_FAST%OutFileRoot)//'.HD_MorisonDistrib_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) + !call MeshWrVTK(p_FAST%TurbinePos, HD%Input(1)%Mesh, trim(p_FAST%VTK_OutFileRoot)//'.HD_Mesh_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) + !call MeshWrVTK(p_FAST%TurbinePos, HD%Input(1)%Morison%LumpedMesh, trim(p_FAST%VTK_OutFileRoot)//'.HD_MorisonLumped_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) + !call MeshWrVTK(p_FAST%TurbinePos, HD%Input(1)%Morison%DistribMesh, trim(p_FAST%VTK_OutFileRoot)//'.HD_MorisonDistrib_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) if (p_FAST%CompSub == Module_NONE) then - call MeshWrVTK(p_FAST%TurbinePos, HD%y%AllHdroOrigin, trim(VTK_path)//'.HD_AllHdroOrigin', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, HD%Input(1)%Mesh ) + call MeshWrVTK(p_FAST%TurbinePos, HD%y%AllHdroOrigin, trim(p_FAST%VTK_OutFileRoot)//'.HD_AllHdroOrigin', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, HD%Input(1)%Mesh ) outputFields = .false. else - call MeshWrVTK(p_FAST%TurbinePos, HD%y%Mesh, trim(VTK_path)//'.HD_Mesh', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, HD%Input(1)%Mesh ) + call MeshWrVTK(p_FAST%TurbinePos, HD%y%Mesh, trim(p_FAST%VTK_OutFileRoot)//'.HD_Mesh', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, HD%Input(1)%Mesh ) outputFields = p_FAST%VTK_fields end if - call MeshWrVTK(p_FAST%TurbinePos, HD%y%Morison%LumpedMesh, trim(VTK_path)//'.HD_MorisonLumped', y_FAST%VTK_count, outputFields, ErrStat2, ErrMsg2, Twidth, HD%Input(1)%Morison%LumpedMesh ) - call MeshWrVTK(p_FAST%TurbinePos, HD%y%Morison%DistribMesh, trim(VTK_path)//'.HD_MorisonDistrib', y_FAST%VTK_count, outputFields, ErrStat2, ErrMsg2, Twidth, HD%Input(1)%Morison%DistribMesh ) + call MeshWrVTK(p_FAST%TurbinePos, HD%y%Morison%LumpedMesh, trim(p_FAST%VTK_OutFileRoot)//'.HD_MorisonLumped', y_FAST%VTK_count, outputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, HD%Input(1)%Morison%LumpedMesh ) + call MeshWrVTK(p_FAST%TurbinePos, HD%y%Morison%DistribMesh, trim(p_FAST%VTK_OutFileRoot)//'.HD_MorisonDistrib', y_FAST%VTK_count, outputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, HD%Input(1)%Morison%DistribMesh ) END IF ! SubDyn IF ( p_FAST%CompSub == Module_SD .and. allocated(SD%Input)) THEN - !call MeshWrVTK(p_FAST%TurbinePos, SD%Input(1)%TPMesh, trim(p_FAST%OutFileRoot)//'.SD_TPMesh_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) - call MeshWrVTK(p_FAST%TurbinePos, SD%Input(1)%LMesh, trim(VTK_path)//'.SD_LMesh_y2Mesh', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, SD%y%y2Mesh ) + !call MeshWrVTK(p_FAST%TurbinePos, SD%Input(1)%TPMesh, trim(p_FAST%VTK_OutFileRoot)//'.SD_TPMesh_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + call MeshWrVTK(p_FAST%TurbinePos, SD%Input(1)%LMesh, trim(p_FAST%VTK_OutFileRoot)//'.SD_LMesh_y2Mesh', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, SD%y%y2Mesh ) - call MeshWrVTK(p_FAST%TurbinePos, SD%y%y1Mesh, trim(VTK_path)//'.SD_y1Mesh_TPMesh', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, SD%Input(1)%TPMesh ) - !call MeshWrVTK(p_FAST%TurbinePos, SD%y%y2Mesh, trim(p_FAST%OutFileRoot)//'.SD_y2Mesh_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) + call MeshWrVTK(p_FAST%TurbinePos, SD%y%y1Mesh, trim(p_FAST%VTK_OutFileRoot)//'.SD_y1Mesh_TPMesh', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, SD%Input(1)%TPMesh ) + !call MeshWrVTK(p_FAST%TurbinePos, SD%y%y2Mesh, trim(p_FAST%VTK_OutFileRoot)//'.SD_y2Mesh_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) ELSE IF ( p_FAST%CompSub == Module_ExtPtfm .and. allocated(ExtPtfm%Input)) THEN - call MeshWrVTK(p_FAST%TurbinePos, ExtPtfm%y%PtfmMesh, trim(VTK_path)//'.ExtPtfm', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, ExtPtfm%Input(1)%PtfmMesh ) + call MeshWrVTK(p_FAST%TurbinePos, ExtPtfm%y%PtfmMesh, trim(p_FAST%VTK_OutFileRoot)//'.ExtPtfm', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, ExtPtfm%Input(1)%PtfmMesh ) END IF ! MAP IF ( p_FAST%CompMooring == Module_MAP ) THEN if (allocated(MAPp%Input)) then - call MeshWrVTK(p_FAST%TurbinePos, MAPp%y%PtFairleadLoad, trim(VTK_path)//'.MAP_PtFairlead', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, MAPp%Input(1)%PtFairDisplacement ) - !call MeshWrVTK(p_FAST%TurbinePos, MAPp%Input(1)%PtFairDisplacement, trim(p_FAST%OutFileRoot)//'.MAP_PtFair_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) + call MeshWrVTK(p_FAST%TurbinePos, MAPp%y%PtFairleadLoad, trim(p_FAST%VTK_OutFileRoot)//'.MAP_PtFairlead', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, MAPp%Input(1)%PtFairDisplacement ) + !call MeshWrVTK(p_FAST%TurbinePos, MAPp%Input(1)%PtFairDisplacement, trim(p_FAST%VTK_OutFileRoot)//'.MAP_PtFair_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) end if ! MoorDyn ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN if (allocated(MD%Input)) then - call MeshWrVTK(p_FAST%TurbinePos, MD%y%PtFairleadLoad, trim(VTK_path)//'.MD_PtFairlead', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, MD%Input(1)%PtFairleadDisplacement ) - !call MeshWrVTK(p_FAST%TurbinePos, MD%Input(1)%PtFairleadDisplacement, trim(p_FAST%OutFileRoot)//'.MD_PtFair_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) + call MeshWrVTK(p_FAST%TurbinePos, MD%y%PtFairleadLoad, trim(p_FAST%VTK_OutFileRoot)//'.MD_PtFairlead', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, MD%Input(1)%PtFairleadDisplacement ) + !call MeshWrVTK(p_FAST%TurbinePos, MD%Input(1)%PtFairleadDisplacement, trim(p_FAST%VTK_OutFileRoot)//'.MD_PtFair_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) end if ! FEAMooring ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN if (allocated(FEAM%Input)) then - call MeshWrVTK(p_FAST%TurbinePos, FEAM%y%PtFairleadLoad, trim(VTK_path)//'.FEAM_PtFairlead', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, FEAM%Input(1)%PtFairleadDisplacement ) - !call MeshWrVTK(p_FAST%TurbinePos, FEAM%Input(1)%PtFairleadDisplacement, trim(p_FAST%OutFileRoot)//'.FEAM_PtFair_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) + call MeshWrVTK(p_FAST%TurbinePos, FEAM%y%PtFairleadLoad, trim(p_FAST%VTK_OutFileRoot)//'.FEAM_PtFairlead', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, FEAM%Input(1)%PtFairleadDisplacement ) + !call MeshWrVTK(p_FAST%TurbinePos, FEAM%Input(1)%PtFairleadDisplacement, trim(p_FAST%VTK_OutFileRoot)//'.FEAM_PtFair_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) end if ! Orca ELSEIF ( p_FAST%CompMooring == Module_Orca ) THEN if (allocated(Orca%Input)) then - call MeshWrVTK(p_FAST%TurbinePos, Orca%y%PtfmMesh, trim(VTK_path)//'.Orca_PtfmMesh', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, Orca%Input(1)%PtfmMesh ) - !call MeshWrVTK(p_FAST%TurbinePos, Orca%Input(1)%PtfmMesh, trim(p_FAST%OutFileRoot)//'.Orca_PtfmMesh_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) + call MeshWrVTK(p_FAST%TurbinePos, Orca%y%PtfmMesh, trim(p_FAST%VTK_OutFileRoot)//'.Orca_PtfmMesh', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, Orca%Input(1)%PtfmMesh ) + !call MeshWrVTK(p_FAST%TurbinePos, Orca%Input(1)%PtfmMesh, trim(p_FAST%VTK_OutFileRoot)//'.Orca_PtfmMesh_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) end if END IF @@ -5164,8 +5194,8 @@ SUBROUTINE WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD14, AD, IfW, O ! IceFloe IF ( p_FAST%CompIce == Module_IceF ) THEN if (allocated(IceF%Input)) then - call MeshWrVTK(p_FAST%TurbinePos, IceF%y%iceMesh, trim(VTK_path)//'.IceF_iceMesh', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, IceF%Input(1)%iceMesh ) - !call MeshWrVTK(p_FAST%TurbinePos, IceF%Input(1)%iceMesh, trim(p_FAST%OutFileRoot)//'.IceF_iceMesh_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) + call MeshWrVTK(p_FAST%TurbinePos, IceF%y%iceMesh, trim(p_FAST%VTK_OutFileRoot)//'.IceF_iceMesh', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, IceF%Input(1)%iceMesh ) + !call MeshWrVTK(p_FAST%TurbinePos, IceF%Input(1)%iceMesh, trim(p_FAST%VTK_OutFileRoot)//'.IceF_iceMesh_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) end if ! IceDyn @@ -5173,8 +5203,8 @@ SUBROUTINE WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD14, AD, IfW, O if (allocated(IceD%Input)) then DO k = 1,p_FAST%numIceLegs - call MeshWrVTK(p_FAST%TurbinePos, IceD%y(k)%PointMesh, trim(VTK_path)//'.IceD_PointMesh'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, IceD%Input(1,k)%PointMesh ) - !call MeshWrVTK(p_FAST%TurbinePos, IceD%Input(1,k)%PointMesh, trim(p_FAST%OutFileRoot)//'.IceD_PointMesh_motion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) + call MeshWrVTK(p_FAST%TurbinePos, IceD%y(k)%PointMesh, trim(p_FAST%VTK_OutFileRoot)//'.IceD_PointMesh'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, IceD%Input(1,k)%PointMesh ) + !call MeshWrVTK(p_FAST%TurbinePos, IceD%Input(1,k)%PointMesh, trim(p_FAST%VTK_OutFileRoot)//'.IceD_PointMesh_motion'//trim(num2lstr(k)), y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) END DO end if @@ -5185,7 +5215,7 @@ END SUBROUTINE WrVTK_AllMeshes !---------------------------------------------------------------------------------------------------------------------------------- !> This routine writes a minimal subset of meshes (enough to visualize the turbine) to VTK-formatted files. It doesn't bother with !! returning an error code. -SUBROUTINE WrVTK_BasicMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD14, AD, IfW, OpFM, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) +SUBROUTINE WrVTK_BasicMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code TYPE(FAST_OutputFileType),INTENT(IN ) :: y_FAST !< Output variables for the glue code @@ -5194,7 +5224,6 @@ SUBROUTINE WrVTK_BasicMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD14, AD, IfW, TYPE(ElastoDyn_Data), INTENT(IN ) :: ED !< ElastoDyn data TYPE(BeamDyn_Data), INTENT(IN ) :: BD !< BeamDyn data TYPE(ServoDyn_Data), INTENT(IN ) :: SrvD !< ServoDyn data - TYPE(AeroDyn14_Data), INTENT(IN ) :: AD14 !< AeroDyn14 data TYPE(AeroDyn_Data), INTENT(IN ) :: AD !< AeroDyn data TYPE(InflowWind_Data), INTENT(IN ) :: IfW !< InflowWind data TYPE(OpenFOAM_Data), INTENT(IN ) :: OpFM !< OpenFOAM data @@ -5208,87 +5237,77 @@ SUBROUTINE WrVTK_BasicMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD14, AD, IfW, TYPE(IceDyn_Data), INTENT(IN ) :: IceD !< All the IceDyn data used in time-step loop logical :: OutputFields - INTEGER(IntKi) :: NumBl, k, Twidth - CHARACTER(1024) :: VTK_path + INTEGER(IntKi) :: NumBl, k INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMSg2 CHARACTER(*), PARAMETER :: RoutineName = 'WrVTK_BasicMeshes' - ! Calculate the number of digits for the maximum number of output steps to be written. - ! This will be used to pad the write-out step in the VTK filename with zeros in calls to MeshWrVTK() - if ( (p_FAST%n_VTKTime>0) .and. (p_FAST%n_TMax_m1+1>0) ) then - Twidth = CEILING( log10( real(p_FAST%n_TMax_m1+1, ReKi) / p_FAST%n_VTKTime ) ) + 1 - else - Twidth = 1 - endif - - + NumBl = 0 - if (allocated(ED%Output(1)%BladeRootMotion)) then - NumBl = SIZE(ED%Output(1)%BladeRootMotion) + if (allocated(ED%y%BladeRootMotion)) then + NumBl = SIZE(ED%y%BladeRootMotion) end if - VTK_path = get_vtkroot_path( p_FAST%OutFileRoot ) - -! Nacelle - call MeshWrVTK(p_FAST%TurbinePos, ED%Output(1)%NacelleMotion, trim(VTK_path)//'.ED_Nacelle', y_FAST%VTK_count, & - p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, Sib=ED%Input(1)%NacelleLoads ) - -! Hub - call MeshWrVTK(p_FAST%TurbinePos, ED%Output(1)%HubPtMotion, trim(VTK_path)//'.ED_Hub', y_FAST%VTK_count, & - p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, Sib=ED%Input(1)%HubPtLoad ) ! Blades IF ( p_FAST%CompAero == Module_AD ) THEN ! These meshes may have airfoil data associated with nodes... DO K=1,NumBl - call MeshWrVTK(p_FAST%TurbinePos, AD%Input(1)%BladeMotion(K), trim(VTK_path)//'.AD_Blade'//trim(num2lstr(k)), & - y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, Sib=AD%y%BladeLoad(K) ) + call MeshWrVTK(p_FAST%TurbinePos, AD%Input(1)%BladeMotion(K), trim(p_FAST%VTK_OutFileRoot)//'.AD_Blade'//trim(num2lstr(k)), & + y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, Sib=AD%y%BladeLoad(K) ) END DO ELSE IF ( p_FAST%CompElast == Module_BD ) THEN DO K=1,NumBl - call MeshWrVTK(p_FAST%TurbinePos, BD%y(k)%BldMotion, trim(VTK_path)//'.BD_BldMotion'//trim(num2lstr(k)), & - y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth ) + call MeshWrVTK(p_FAST%TurbinePos, BD%y(k)%BldMotion, trim(p_FAST%VTK_OutFileRoot)//'.BD_BldMotion'//trim(num2lstr(k)), & + y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) END DO - ELSE + ELSE IF ( p_FAST%CompElast == Module_ED ) THEN DO K=1,NumBl - call MeshWrVTK(p_FAST%TurbinePos, ED%Output(1)%BladeLn2Mesh(K), trim(VTK_path)//'.ED_BladeLn2Mesh_motion'//trim(num2lstr(k)), & - y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth ) + call MeshWrVTK(p_FAST%TurbinePos, ED%y%BladeLn2Mesh(K), trim(p_FAST%VTK_OutFileRoot)//'.ED_BladeLn2Mesh_motion'//trim(num2lstr(k)), & + y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) END DO END IF - + +! Nacelle + call MeshWrVTK(p_FAST%TurbinePos, ED%y%NacelleMotion, trim(p_FAST%VTK_OutFileRoot)//'.ED_Nacelle', y_FAST%VTK_count, & + p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, Sib=ED%Input(1)%NacelleLoads ) + +! Hub + call MeshWrVTK(p_FAST%TurbinePos, ED%y%HubPtMotion, trim(p_FAST%VTK_OutFileRoot)//'.ED_Hub', y_FAST%VTK_count, & + p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, Sib=ED%Input(1)%HubPtLoad ) ! Tower motions - call MeshWrVTK(p_FAST%TurbinePos, ED%Output(1)%TowerLn2Mesh, trim(VTK_path)//'.ED_TowerLn2Mesh_motion', & - y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth ) + call MeshWrVTK(p_FAST%TurbinePos, ED%y%TowerLn2Mesh, trim(p_FAST%VTK_OutFileRoot)//'.ED_TowerLn2Mesh_motion', & + y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) + ! Substructure -! call MeshWrVTK(p_FAST%TurbinePos, ED%Output(1)%PlatformPtMesh, trim(p_FAST%OutFileRoot)//'.ED_PlatformPtMesh_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) +! call MeshWrVTK(p_FAST%TurbinePos, ED%y%PlatformPtMesh, trim(p_FAST%VTK_OutFileRoot)//'.ED_PlatformPtMesh_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) ! IF ( p_FAST%CompSub == Module_SD ) THEN -! call MeshWrVTK(p_FAST%TurbinePos, SD%Input(1)%TPMesh, trim(p_FAST%OutFileRoot)//'.SD_TPMesh_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) -! call MeshWrVTK(p_FAST%TurbinePos, SD%y%y2Mesh, trim(p_FAST%OutFileRoot)//'.SD_y2Mesh_motion', y_FAST%VTK_count, ErrStat2, ErrMsg2 ) +! call MeshWrVTK(p_FAST%TurbinePos, SD%Input(1)%TPMesh, trim(p_FAST%VTK_OutFileRoot)//'.SD_TPMesh_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) +! call MeshWrVTK(p_FAST%TurbinePos, SD%y%y2Mesh, trim(p_FAST%VTK_OutFileRoot)//'.SD_y2Mesh_motion', y_FAST%VTK_count, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) ! END IF IF ( p_FAST%CompHydro == Module_HD ) THEN if (p_FAST%CompSub == Module_NONE) then - call MeshWrVTK(p_FAST%TurbinePos, HD%y%AllHdroOrigin, trim(VTK_path)//'.HD_AllHdroOrigin', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, Twidth, HD%Input(1)%Mesh ) + call MeshWrVTK(p_FAST%TurbinePos, HD%y%AllHdroOrigin, trim(p_FAST%VTK_OutFileRoot)//'.HD_AllHdroOrigin', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, HD%Input(1)%Mesh ) outputFields = .false. else OutputFields = p_FAST%VTK_fields end if - call MeshWrVTK(p_FAST%TurbinePos, HD%Input(1)%Morison%DistribMesh, trim(VTK_path)//'.HD_MorisonDistrib', & - y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, Twidth, Sib=HD%y%Morison%DistribMesh ) + call MeshWrVTK(p_FAST%TurbinePos, HD%Input(1)%Morison%DistribMesh, trim(p_FAST%VTK_OutFileRoot)//'.HD_MorisonDistrib', & + y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, Sib=HD%y%Morison%DistribMesh ) END IF ! Mooring Lines? ! IF ( p_FAST%CompMooring == Module_MAP ) THEN -! call MeshWrVTK(p_FAST%TurbinePos, MAPp%Input(1)%PtFairDisplacement, trim(p_FAST%OutFileRoot)//'.MAP_PtFair_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) +! call MeshWrVTK(p_FAST%TurbinePos, MAPp%Input(1)%PtFairDisplacement, trim(p_FAST%VTK_OutFileRoot)//'.MAP_PtFair_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) ! ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN -! call MeshWrVTK(p_FAST%TurbinePos, MD%Input(1)%PtFairleadDisplacement, trim(p_FAST%OutFileRoot)//'.MD_PtFair_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) +! call MeshWrVTK(p_FAST%TurbinePos, MD%Input(1)%PtFairleadDisplacement, trim(p_FAST%VTK_OutFileRoot)//'.MD_PtFair_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) ! ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN -! call MeshWrVTK(p_FAST%TurbinePos, FEAM%Input(1)%PtFairleadDisplacement, trim(p_FAST%OutFileRoot)//'FEAM_PtFair_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2 ) +! call MeshWrVTK(p_FAST%TurbinePos, FEAM%Input(1)%PtFairleadDisplacement, trim(p_FAST%VTK_OutFileRoot)//'FEAM_PtFair_motion', y_FAST%VTK_count, p_FAST%VTK_fields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth ) ! END IF @@ -5296,7 +5315,7 @@ END SUBROUTINE WrVTK_BasicMeshes !---------------------------------------------------------------------------------------------------------------------------------- !> This routine writes a minimal subset of meshes with surfaces to VTK-formatted files. It doesn't bother with !! returning an error code. -SUBROUTINE WrVTK_Surfaces(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD14, AD, IfW, OpFM, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) +SUBROUTINE WrVTK_Surfaces(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) REAL(DbKi), INTENT(IN ) :: t_global !< Current global time TYPE(FAST_ParameterType), INTENT(IN ) :: p_FAST !< Parameters for the glue code @@ -5306,7 +5325,6 @@ SUBROUTINE WrVTK_Surfaces(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD14, A TYPE(ElastoDyn_Data), INTENT(IN ) :: ED !< ElastoDyn data TYPE(BeamDyn_Data), INTENT(IN ) :: BD !< BeamDyn data TYPE(ServoDyn_Data), INTENT(IN ) :: SrvD !< ServoDyn data - TYPE(AeroDyn14_Data), INTENT(IN ) :: AD14 !< AeroDyn14 data TYPE(AeroDyn_Data), INTENT(IN ) :: AD !< AeroDyn data TYPE(InflowWind_Data), INTENT(IN ) :: IfW !< InflowWind data TYPE(OpenFOAM_Data), INTENT(IN ) :: OpFM !< OpenFOAM data @@ -5321,76 +5339,64 @@ SUBROUTINE WrVTK_Surfaces(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD14, A logical, parameter :: OutputFields = .FALSE. ! due to confusion about what fields mean on a surface, we are going to just output the basic meshes if people ask for fields - INTEGER(IntKi) :: NumBl, k, Twidth - CHARACTER(1024) :: VTK_path + INTEGER(IntKi) :: NumBl, k INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMSg2 CHARACTER(*), PARAMETER :: RoutineName = 'WrVTK_Surfaces' - ! Calculate the number of digits for the maximum number of output steps to be written. - ! This will be used to pad the write-out step in the VTK filename with zeros in calls to MeshWrVTK() - if ( (p_FAST%n_VTKTime>0) .and. (p_FAST%n_TMax_m1+1>0) ) then - Twidth = CEILING( log10( real(p_FAST%n_TMax_m1+1, ReKi) / p_FAST%n_VTKTime ) ) + 1 - else - Twidth = 1 - endif - - NumBl = 0 - if (allocated(ED%Output(1)%BladeRootMotion)) then - NumBl = SIZE(ED%Output(1)%BladeRootMotion) + if (allocated(ED%y%BladeRootMotion)) then + NumBl = SIZE(ED%y%BladeRootMotion) end if - VTK_path = get_vtkroot_path( p_FAST%OutFileRoot ) - ! Ground (written at initialization) ! Wave elevation if ( allocated( p_FAST%VTK_Surface%WaveElev ) ) call WrVTK_WaveElev( t_global, p_FAST, y_FAST, HD) - ! Nacelle - call MeshWrVTK_PointSurface (p_FAST%TurbinePos, ED%Output(1)%NacelleMotion, trim(VTK_path)//'.NacelleSurface', & - y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, Twidth , verts = p_FAST%VTK_Surface%NacelleBox, Sib=ED%Input(1)%NacelleLoads ) + call MeshWrVTK_PointSurface (p_FAST%TurbinePos, ED%y%NacelleMotion, trim(p_FAST%VTK_OutFileRoot)//'.NacelleSurface', & + y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth , verts = p_FAST%VTK_Surface%NacelleBox, Sib=ED%Input(1)%NacelleLoads ) ! Hub - call MeshWrVTK_PointSurface (p_FAST%TurbinePos, ED%Output(1)%HubPtMotion, trim(VTK_path)//'.HubSurface', & - y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, Twidth , & + call MeshWrVTK_PointSurface (p_FAST%TurbinePos, ED%y%HubPtMotion, trim(p_FAST%VTK_OutFileRoot)//'.HubSurface', & + y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth , & NumSegments=p_FAST%VTK_Surface%NumSectors, radius=p_FAST%VTK_Surface%HubRad, Sib=ED%Input(1)%HubPtLoad ) +! Tower motions + call MeshWrVTK_Ln2Surface (p_FAST%TurbinePos, ED%y%TowerLn2Mesh, trim(p_FAST%VTK_OutFileRoot)//'.TowerSurface', & + y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, p_FAST%VTK_Surface%NumSectors, p_FAST%VTK_Surface%TowerRad ) + ! Blades IF ( p_FAST%CompAero == Module_AD ) THEN ! These meshes may have airfoil data associated with nodes... DO K=1,NumBl - call MeshWrVTK_Ln2Surface (p_FAST%TurbinePos, AD%Input(1)%BladeMotion(K), trim(VTK_path)//'.Blade'//trim(num2lstr(k))//'Surface', & - y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, Twidth , verts=p_FAST%VTK_Surface%BladeShape(K)%AirfoilCoords & + call MeshWrVTK_Ln2Surface (p_FAST%TurbinePos, AD%Input(1)%BladeMotion(K), trim(p_FAST%VTK_OutFileRoot)//'.Blade'//trim(num2lstr(k))//'Surface', & + y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth , verts=p_FAST%VTK_Surface%BladeShape(K)%AirfoilCoords & ,Sib=AD%y%BladeLoad(k) ) END DO ELSE IF ( p_FAST%CompElast == Module_BD ) THEN DO K=1,NumBl - call MeshWrVTK_Ln2Surface (p_FAST%TurbinePos, BD%y(k)%BldMotion, trim(VTK_path)//'.Blade'//trim(num2lstr(k))//'Surface', & - y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, Twidth , verts=p_FAST%VTK_Surface%BladeShape(K)%AirfoilCoords ) + call MeshWrVTK_Ln2Surface (p_FAST%TurbinePos, BD%y(k)%BldMotion, trim(p_FAST%VTK_OutFileRoot)//'.Blade'//trim(num2lstr(k))//'Surface', & + y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth , verts=p_FAST%VTK_Surface%BladeShape(K)%AirfoilCoords ) END DO - ELSE + ELSE IF ( p_FAST%CompElast == Module_ED ) THEN DO K=1,NumBl - call MeshWrVTK_Ln2Surface (p_FAST%TurbinePos, ED%Output(1)%BladeLn2Mesh(K), trim(VTK_path)//'.Blade'//trim(num2lstr(k))//'Surface', & - y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, Twidth , verts=p_FAST%VTK_Surface%BladeShape(K)%AirfoilCoords ) + call MeshWrVTK_Ln2Surface (p_FAST%TurbinePos, ED%y%BladeLn2Mesh(K), trim(p_FAST%VTK_OutFileRoot)//'.Blade'//trim(num2lstr(k))//'Surface', & + y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth , verts=p_FAST%VTK_Surface%BladeShape(K)%AirfoilCoords ) END DO END IF -! Tower motions - call MeshWrVTK_Ln2Surface (p_FAST%TurbinePos, ED%Output(1)%TowerLn2Mesh, trim(VTK_path)//'.TowerSurface', & - y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, Twidth, p_FAST%VTK_Surface%NumSectors, p_FAST%VTK_Surface%TowerRad ) ! Platform -! call MeshWrVTK_PointSurface (p_FAST%TurbinePos, ED%Output(1)%PlatformPtMesh, trim(p_FAST%OutFileRoot)//'.PlatformSurface', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, Radius = p_FAST%VTK_Surface%GroundRad ) +! call MeshWrVTK_PointSurface (p_FAST%TurbinePos, ED%y%PlatformPtMesh, trim(p_FAST%VTK_OutFileRoot)//'.PlatformSurface', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, Radius = p_FAST%VTK_Surface%GroundRad ) ! Substructure -! call MeshWrVTK(p_FAST%TurbinePos, ED%Output(1)%PlatformPtMesh, trim(p_FAST%OutFileRoot)//'.ED_PlatformPtMesh_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) +! call MeshWrVTK(p_FAST%TurbinePos, ED%y%PlatformPtMesh, trim(p_FAST%VTK_OutFileRoot)//'.ED_PlatformPtMesh_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) ! IF ( p_FAST%CompSub == Module_SD ) THEN -! call MeshWrVTK(p_FAST%TurbinePos, SD%Input(1)%TPMesh, trim(p_FAST%OutFileRoot)//'.SD_TPMesh_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) -! call MeshWrVTK(p_FAST%TurbinePos, SD%y%y2Mesh, trim(p_FAST%OutFileRoot)//'.SD_y2Mesh_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) +! call MeshWrVTK(p_FAST%TurbinePos, SD%Input(1)%TPMesh, trim(p_FAST%VTK_OutFileRoot)//'.SD_TPMesh_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) +! call MeshWrVTK(p_FAST%TurbinePos, SD%y%y2Mesh, trim(p_FAST%VTK_OutFileRoot)//'.SD_y2Mesh_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) ! END IF IF ( HD%Input(1)%Morison%DistribMesh%Committed ) THEN @@ -5400,24 +5406,24 @@ SUBROUTINE WrVTK_Surfaces(t_global, p_FAST, y_FAST, MeshMapData, ED, BD, AD14, A ! OutputFields = p_FAST%VTK_fields !end if - call MeshWrVTK_Ln2Surface (p_FAST%TurbinePos, HD%Input(1)%Morison%DistribMesh, trim(VTK_path)//'.MorisonSurface', & - y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, Twidth, p_FAST%VTK_Surface%NumSectors, & + call MeshWrVTK_Ln2Surface (p_FAST%TurbinePos, HD%Input(1)%Morison%DistribMesh, trim(p_FAST%VTK_OutFileRoot)//'.MorisonSurface', & + y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2, p_FAST%VTK_tWidth, p_FAST%VTK_Surface%NumSectors, & p_FAST%VTK_Surface%MorisonRad, Sib=HD%y%Morison%DistribMesh ) END IF ! Mooring Lines? ! IF ( p_FAST%CompMooring == Module_MAP ) THEN -! call MeshWrVTK(p_FAST%TurbinePos, MAPp%Input(1)%PtFairDisplacement, trim(p_FAST%OutFileRoot)//'.MAP_PtFair_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) +! call MeshWrVTK(p_FAST%TurbinePos, MAPp%Input(1)%PtFairDisplacement, trim(p_FAST%VTK_OutFileRoot)//'.MAP_PtFair_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) ! ELSEIF ( p_FAST%CompMooring == Module_MD ) THEN -! call MeshWrVTK(p_FAST%TurbinePos, MD%Input(1)%PtFairleadDisplacement, trim(p_FAST%OutFileRoot)//'.MD_PtFair_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) +! call MeshWrVTK(p_FAST%TurbinePos, MD%Input(1)%PtFairleadDisplacement, trim(p_FAST%VTK_OutFileRoot)//'.MD_PtFair_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) ! ELSEIF ( p_FAST%CompMooring == Module_FEAM ) THEN -! call MeshWrVTK(p_FAST%TurbinePos, FEAM%Input(1)%PtFairleadDisplacement, trim(p_FAST%OutFileRoot)//'FEAM_PtFair_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) +! call MeshWrVTK(p_FAST%TurbinePos, FEAM%Input(1)%PtFairleadDisplacement, trim(p_FAST%VTK_OutFileRoot)//'FEAM_PtFair_motion', y_FAST%VTK_count, OutputFields, ErrStat2, ErrMsg2 ) ! END IF if (p_FAST%VTK_fields) then - call WrVTK_BasicMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD14, AD, IfW, OpFM, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) + call WrVTK_BasicMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) end if @@ -5440,8 +5446,7 @@ SUBROUTINE WrVTK_WaveElev(t_global, p_FAST, y_FAST, HD) INTEGER(IntKi) :: NumberOfPoints INTEGER(IntKi), parameter :: NumberOfLines = 0 INTEGER(IntKi) :: NumberOfPolys - INTEGER(IntKi) :: Twidth - CHARACTER(1024) :: VTK_path, Tstr = '' + CHARACTER(1024) :: Tstr INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*),PARAMETER :: RoutineName = 'WrVTK_WaveElev' @@ -5455,21 +5460,11 @@ SUBROUTINE WrVTK_WaveElev(t_global, p_FAST, y_FAST, HD) !................................................................. ! write the data that potentially changes each time step: !................................................................. - ! Calculate the number of digits for the maximum number of output steps to be written. - ! This will be used to pad the write-out step in the VTK filename with zeros in calls to MeshWrVTK() - if ( (p_FAST%n_VTKTime>0) .and. (p_FAST%n_TMax_m1+1>0) ) then - Twidth = CEILING( log10( real(p_FAST%n_TMax_m1+1, ReKi) / p_FAST%n_VTKTime ) ) + 1 - else - Twidth = 1 - endif - - VTK_path = get_vtkroot_path( p_FAST%OutFileRoot ) - ! construct the string for the zero-padded VTK write-out step - write(Tstr(1 : Twidth), '(i' // trim(Num2LStr(Twidth)) //'.'// trim(Num2LStr(Twidth)) // ')') y_FAST%VTK_count + write(Tstr, '(i' // trim(Num2LStr(p_FAST%VTK_tWidth)) //'.'// trim(Num2LStr(p_FAST%VTK_tWidth)) // ')') y_FAST%VTK_count ! PolyData (.vtp) - Serial vtkPolyData (unstructured) file - FileName = TRIM(VTK_path)//'.WaveSurface.'//TRIM(Tstr)//'.vtp' + FileName = TRIM(p_FAST%VTK_OutFileRoot)//'.WaveSurface.'//TRIM(Tstr)//'.vtp' call WrVTK_header( FileName, NumberOfPoints, NumberOfLines, NumberOfPolys, Un, ErrStat2, ErrMsg2 ) if (ErrStat2 >= AbortErrLev) return @@ -5775,10 +5770,10 @@ SUBROUTINE FAST_Linearize_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg) ! local variables REAL(DbKi) :: t_global ! current simulation time REAL(DbKi) :: next_lin_time ! next simulation time where linearization analysis should be performed + INTEGER(IntKi) :: iLinTime ! loop counter INTEGER(IntKi) :: ErrStat2 ! local error status CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message - CHARACTER(MaxWrScrLen) :: BlankLine - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Linearize_T' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_Linearize_T' ErrStat = ErrID_None @@ -5786,34 +5781,82 @@ SUBROUTINE FAST_Linearize_T(t_initial, n_t_global, Turbine, ErrStat, ErrMsg) if ( .not. Turbine%p_FAST%Linearize ) return - if (Turbine%m_FAST%NextLinTimeIndx <= size(Turbine%p_FAST%LinTimes) ) then !bjj: maybe this logic should go in FAST_Linearize_OP??? + if (.not. Turbine%p_FAST%CalcSteady) then + + if ( Turbine%m_FAST%Lin%NextLinTimeIndx <= Turbine%p_FAST%NLinTimes ) then !bjj: maybe this logic should go in FAST_Linearize_OP??? - next_lin_time = Turbine%p_FAST%LinTimes( Turbine%m_FAST%NextLinTimeIndx ) - t_global = t_initial + n_t_global*Turbine%p_FAST%dt + next_lin_time = Turbine%m_FAST%Lin%LinTimes( Turbine%m_FAST%Lin%NextLinTimeIndx ) + t_global = t_initial + n_t_global*Turbine%p_FAST%dt - if ( EqualRealNos( t_global, next_lin_time ) .or. t_global > next_lin_time ) then - - BlankLine = "" - CALL WrOver( BlankLine ) ! BlankLine contains MaxWrScrLen spaces - CALL WrOver ( ' Performing linearization at simulation time '//TRIM( Num2LStr(t_global) )//' s. (RotSpeed='& - //trim(num2lstr(Turbine%ED%Output(1)%RotSpeed*RPS2RPM))//' rpm, BldPitch1='//trim(num2lstr(Turbine%ED%Output(1)%BlPitch(1)*R2D))//' deg)' ) - CALL WrScr('') + if ( EqualRealNos( t_global, next_lin_time ) .or. t_global > next_lin_time ) then + + CALL FAST_Linearize_OP(t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & + Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%IfW, Turbine%OpFM, & + Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & + Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF (ErrStat >= AbortErrLev) RETURN + + if (Turbine%p_FAST%WrVTK == VTK_ModeShapes) then + if (Turbine%m_FAST%Lin%NextLinTimeIndx > Turbine%p_FAST%NLinTimes) call WrVTKCheckpoint() + end if + + end if + end if + + else ! CalcSteady - CALL FAST_Linearize_OP(t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & - Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%IfW, Turbine%OpFM, & - Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - IF (ErrStat >= AbortErrLev) RETURN + t_global = t_initial + n_t_global*Turbine%p_FAST%dt + + call FAST_CalcSteady( n_t_global, t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, Turbine%ED, Turbine%BD, Turbine%SrvD, & + Turbine%AD, Turbine%IfW, Turbine%OpFM, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, & + Turbine%Orca, Turbine%IceF, Turbine%IceD, ErrStat2, ErrMsg2 ) + call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + if (Turbine%m_FAST%Lin%FoundSteady) then + + do iLinTime=1,Turbine%p_FAST%NLinTimes + t_global = Turbine%m_FAST%Lin%LinTimes(iLinTime) + + call SetOperatingPoint(iLinTime, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, Turbine%ED, Turbine%BD, Turbine%SrvD, & + Turbine%AD, Turbine%IfW, Turbine%OpFM, Turbine%HD, Turbine%SD, Turbine%ExtPtfm, & + Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, Turbine%IceF, Turbine%IceD, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + if (Turbine%p_FAST%DT_UJac < Turbine%p_FAST%TMax) then + Turbine%m_FAST%calcJacobian = .true. + Turbine%m_FAST%NextJacCalcTime = t_global + end if + + CALL CalcOutputs_And_SolveForInputs( -1, t_global, STATE_CURR, Turbine%m_FAST%calcJacobian, Turbine%m_FAST%NextJacCalcTime, & + Turbine%p_FAST, Turbine%m_FAST, .false., Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%IfW, Turbine%OpFM, & + Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF (ErrStat >= AbortErrLev) RETURN + + CALL FAST_Linearize_OP(t_global, Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & + Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD, Turbine%IfW, Turbine%OpFM, & + Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & + Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF (ErrStat >= AbortErrLev) RETURN - Turbine%m_FAST%NextLinTimeIndx = Turbine%m_FAST%NextLinTimeIndx + 1 + end do + + if (Turbine%p_FAST%WrVTK == VTK_ModeShapes) CALL WrVTKCheckpoint() end if end if + return - +contains + subroutine WrVTKCheckpoint() + ! we are creating a checkpoint file for each turbine, so setting NumTurbines=1 in the file + CALL FAST_CreateCheckpoint_T(t_initial, Turbine%p_FAST%n_TMax_m1+1, 1, Turbine, TRIM(Turbine%p_FAST%OutFileRoot)//'.ModeShapeVTK', ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + end subroutine WrVTKCheckpoint END SUBROUTINE FAST_Linearize_T !---------------------------------------------------------------------------------------------------------------------------------- @@ -5823,12 +5866,21 @@ END SUBROUTINE FAST_Linearize_T !> Routine that calls ExitThisProgram for one instance of a Turbine data structure. This is a separate subroutine so that the FAST !! driver programs do not need to change or operate on the individual module level. !! This routine should be called from glue code only (e.g., FAST_Prog.f90). It should not be called in any of these driver routines. -SUBROUTINE ExitThisProgram_T( Turbine, ErrLevel_in, StopTheProgram, ErrLocMsg ) +SUBROUTINE ExitThisProgram_T( Turbine, ErrLevel_in, StopTheProgram, ErrLocMsg, SkipRunTimeMsg ) TYPE(FAST_TurbineType), INTENT(INOUT) :: Turbine !< Data for one turbine instance INTEGER(IntKi), INTENT(IN) :: ErrLevel_in !< Error level when Error == .TRUE. (required when Error is .TRUE.) LOGICAL, INTENT(IN) :: StopTheProgram !< flag indicating if the program should end (false if there are more turbines to end) CHARACTER(*), OPTIONAL, INTENT(IN) :: ErrLocMsg !< an optional message describing the location of the error + LOGICAL, OPTIONAL, INTENT(IN) :: SkipRunTimeMsg !< an optional message describing run-time stats + + LOGICAL :: SkipRunTimes + + IF (PRESENT(SkipRunTimeMsg)) THEN + SkipRunTimes = SkipRunTimeMsg + ELSE + SkipRunTimes = .FALSE. + END IF IF (PRESENT(ErrLocMsg)) THEN @@ -5836,14 +5888,14 @@ SUBROUTINE ExitThisProgram_T( Turbine, ErrLevel_in, StopTheProgram, ErrLocMsg ) CALL ExitThisProgram( Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%IfW, Turbine%OpFM, & Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrLevel_in, StopTheProgram, ErrLocMsg ) + Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrLevel_in, StopTheProgram, ErrLocMsg, SkipRunTimes ) ELSE CALL ExitThisProgram( Turbine%p_FAST, Turbine%y_FAST, Turbine%m_FAST, & Turbine%ED, Turbine%BD, Turbine%SrvD, Turbine%AD14, Turbine%AD, Turbine%IfW, Turbine%OpFM, & Turbine%HD, Turbine%SD, Turbine%ExtPtfm, Turbine%MAP, Turbine%FEAM, Turbine%MD, Turbine%Orca, & - Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrLevel_in, StopTheProgram ) + Turbine%IceF, Turbine%IceD, Turbine%MeshMapData, ErrLevel_in, StopTheProgram, SkipRunTimeMsg=SkipRunTimes ) END IF @@ -5854,7 +5906,7 @@ END SUBROUTINE ExitThisProgram_T !! This routine should not be called from glue code (e.g., FAST_Prog.f90) or ExitThisProgram_T only. It should not be called in any !! of these driver routines. SUBROUTINE ExitThisProgram( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, & - MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrLevel_in, StopTheProgram, ErrLocMsg ) + MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrLevel_in, StopTheProgram, ErrLocMsg, SkipRunTimeMsg ) !............................................................................................................................... ! Passed arguments @@ -5884,28 +5936,27 @@ SUBROUTINE ExitThisProgram( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, INTEGER(IntKi), INTENT(IN) :: ErrLevel_in !< Error level when Error == .TRUE. (required when Error is .TRUE.) LOGICAL, INTENT(IN) :: StopTheProgram !< flag indicating if the program should end (false if there are more turbines to end) CHARACTER(*), OPTIONAL, INTENT(IN) :: ErrLocMsg !< an optional message describing the location of the error + LOGICAL, OPTIONAL, INTENT(IN) :: SkipRunTimeMsg !< an optional message describing run-time stats ! Local variables: INTEGER(IntKi) :: ErrorLevel + LOGICAL :: PrintRunTimes INTEGER(IntKi) :: ErrStat2 ! Error status CHARACTER(ErrMsgLen) :: ErrMsg2 ! Error message CHARACTER(1224) :: SimMsg ! optional message to print about where the error took place in the simulation CHARACTER(*), PARAMETER :: RoutineName = 'ExitThisProgram' - CHARACTER( LEN(p_FAST%OutFileRoot) ) :: TmpOutFileRoot ErrorLevel = ErrLevel_in ! for debugging, let's output the meshes and all of their fields IF ( ErrorLevel >= AbortErrLev .AND. p_FAST%WrVTK > VTK_None) THEN - TmpOutFileRoot = p_FAST%OutFileRoot - p_FAST%OutFileRoot = trim(p_FAST%OutFileRoot)//'.DebugError' + p_FAST%VTK_OutFileRoot = trim(p_FAST%VTK_OutFileRoot)//'.DebugError' p_FAST%VTK_fields = .true. - CALL WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) - p_FAST%OutFileRoot = TmpOutFileRoot + CALL WrVTK_AllMeshes(p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) end if @@ -5936,6 +5987,12 @@ SUBROUTINE ExitThisProgram( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, ELSE SimMsg = 'after the simulation completed' END IF + + IF (y_FAST%UnSum > 0) THEN + CLOSE(y_FAST%UnSum) + y_FAST%UnSum = -1 + END IF + SimMsg = 'FAST encountered an error '//TRIM(SimMsg)//'.'//NewLine//' Simulation error level: '//TRIM(GetErrStr(ErrorLevel)) if (StopTheProgram) then @@ -5949,11 +6006,19 @@ SUBROUTINE ExitThisProgram( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, !............................................................................................................................ ! Write simulation times and stop !............................................................................................................................ - - IF (p_FAST%WrSttsTime) THEN - CALL RunTimes( m_FAST%StrtTime, m_FAST%UsrTime1, m_FAST%SimStrtTime, m_FAST%UsrTime2, m_FAST%t_global, DescStrIn=p_FAST%TDesc ) - END IF + if (present(SkipRunTimeMsg)) then + PrintRunTimes = .not. SkipRunTimeMsg + else + PrintRunTimes = .true. + end if + IF (p_FAST%WrSttsTime .and. PrintRunTimes) THEN + CALL RunTimes( m_FAST%StrtTime, m_FAST%UsrTime1, m_FAST%SimStrtTime, m_FAST%UsrTime2, m_FAST%t_global, UnSum=y_FAST%UnSum, DescStrIn=p_FAST%TDesc ) + END IF + IF (y_FAST%UnSum > 0) THEN + CLOSE(y_FAST%UnSum) + y_FAST%UnSum = -1 + END IF if (StopTheProgram) then #if (defined COMPILE_SIMULINK || defined COMPILE_LABVIEW) @@ -5969,10 +6034,11 @@ END SUBROUTINE ExitThisProgram !---------------------------------------------------------------------------------------------------------------------------------- !> This subroutine is called at program termination. It writes any additional output files, !! deallocates variables for FAST file I/O and closes files. -SUBROUTINE FAST_EndOutput( p_FAST, y_FAST, ErrStat, ErrMsg ) +SUBROUTINE FAST_EndOutput( p_FAST, y_FAST, m_FAST, ErrStat, ErrMsg ) TYPE(FAST_ParameterType), INTENT(INOUT) :: p_FAST !< FAST Parameters TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< FAST Output + TYPE(FAST_MiscVarType), INTENT(IN ) :: m_FAST !< Miscellaneous variables (only for the final time) INTEGER(IntKi), INTENT(OUT) :: ErrStat !< Error status CHARACTER(*), INTENT(OUT) :: ErrMsg !< Message associated with errro status @@ -6074,12 +6140,12 @@ SUBROUTINE FAST_EndMods( p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, HD ErrMsg = "" - CALL FAST_EndOutput( p_FAST, y_FAST, ErrStat2, ErrMsg2 ) + CALL FAST_EndOutput( p_FAST, y_FAST, m_FAST, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF ( p_FAST%ModuleInitialized(Module_ED) ) THEN CALL ED_End( ED%Input(1), ED%p, ED%x(STATE_CURR), ED%xd(STATE_CURR), ED%z(STATE_CURR), ED%OtherSt(STATE_CURR), & - ED%Output(1), ED%m, ErrStat2, ErrMsg2 ) + ED%y, ED%m, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) END IF @@ -6346,6 +6412,7 @@ END SUBROUTINE FAST_CreateCheckpoint_Tary SUBROUTINE FAST_CreateCheckpoint_T(t_initial, n_t_global, NumTurbines, Turbine, CheckpointRoot, ErrStat, ErrMsg, Unit ) USE BladedInterface, ONLY: CallBladedDLL ! Hack for Bladed-style DLL + USE BladedInterface, ONLY: GH_DISCON_STATUS_CHECKPOINT REAL(DbKi), INTENT(IN ) :: t_initial !< initial time INTEGER(IntKi), INTENT(IN ) :: n_t_global !< loop counter @@ -6452,18 +6519,20 @@ SUBROUTINE FAST_CreateCheckpoint_T(t_initial, n_t_global, NumTurbines, Turbine, if (Turbine%SrvD%m%dll_data%avrSWAP( 1) > 0 ) then ! store value to be overwritten old_avrSwap1 = Turbine%SrvD%m%dll_data%avrSWAP( 1) - FileName = Turbine%SrvD%p%DLL_InFile + FileName = Turbine%SrvD%m%dll_data%DLL_InFile ! overwrite values: - Turbine%SrvD%p%DLL_InFile = DLLFileName + Turbine%SrvD%m%dll_data%DLL_InFile = DLLFileName Turbine%SrvD%m%dll_data%avrSWAP(50) = REAL( LEN_TRIM(DLLFileName) ) +1 ! No. of characters in the "INFILE" argument (-) (we add one for the C NULL CHARACTER) - Turbine%SrvD%m%dll_data%avrSWAP( 1) = -8 - CALL CallBladedDLL(Turbine%SrvD%Input(1), Turbine%SrvD%p%DLL_Trgt, Turbine%SrvD%m%dll_data, Turbine%SrvD%p, ErrStat2, ErrMsg2) + Turbine%SrvD%m%dll_data%avrSWAP( 1) = GH_DISCON_STATUS_CHECKPOINT + Turbine%SrvD%m%dll_data%SimStatus = Turbine%SrvD%m%dll_data%avrSWAP( 1) + CALL CallBladedDLL(Turbine%SrvD%Input(1), Turbine%SrvD%p, Turbine%SrvD%m%dll_data, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! put values back: - Turbine%SrvD%p%DLL_InFile = FileName + Turbine%SrvD%m%dll_data%DLL_InFile = FileName Turbine%SrvD%m%dll_data%avrSWAP(50) = REAL( LEN_TRIM(FileName) ) +1 ! No. of characters in the "INFILE" argument (-) (we add one for the C NULL CHARACTER) Turbine%SrvD%m%dll_data%avrSWAP( 1) = old_avrSwap1 + Turbine%SrvD%m%dll_data%SimStatus = Turbine%SrvD%m%dll_data%avrSWAP( 1) end if END IF @@ -6525,6 +6594,7 @@ END SUBROUTINE FAST_RestoreFromCheckpoint_Tary !! the turbine instance. SUBROUTINE FAST_RestoreFromCheckpoint_T(t_initial, n_t_global, NumTurbines, Turbine, CheckpointRoot, ErrStat, ErrMsg, Unit ) USE BladedInterface, ONLY: CallBladedDLL ! Hack for Bladed-style DLL + USE BladedInterface, ONLY: GH_DISCON_STATUS_RESTARTING REAL(DbKi), INTENT(INOUT) :: t_initial !< initial time INTEGER(IntKi), INTENT(INOUT) :: n_t_global !< loop counter @@ -6650,17 +6720,19 @@ SUBROUTINE FAST_RestoreFromCheckpoint_T(t_initial, n_t_global, NumTurbines, Turb if (Turbine%SrvD%m%dll_data%avrSWAP( 1) > 0 ) then ! this isn't allocated if UseBladedInterface is FALSE ! store value to be overwritten old_avrSwap1 = Turbine%SrvD%m%dll_data%avrSWAP( 1) - FileName = Turbine%SrvD%p%DLL_InFile + FileName = Turbine%SrvD%m%dll_data%DLL_InFile ! overwrite values before calling DLL: - Turbine%SrvD%p%DLL_InFile = DLLFileName + Turbine%SrvD%m%dll_data%DLL_InFile = DLLFileName Turbine%SrvD%m%dll_data%avrSWAP(50) = REAL( LEN_TRIM(DLLFileName) ) +1 ! No. of characters in the "INFILE" argument (-) (we add one for the C NULL CHARACTER) - Turbine%SrvD%m%dll_data%avrSWAP( 1) = -9 - CALL CallBladedDLL(Turbine%SrvD%Input(1), Turbine%SrvD%p%DLL_Trgt, Turbine%SrvD%m%dll_data, Turbine%SrvD%p, ErrStat2, ErrMsg2) + Turbine%SrvD%m%dll_data%avrSWAP( 1) = GH_DISCON_STATUS_RESTARTING + Turbine%SrvD%m%dll_data%SimStatus = Turbine%SrvD%m%dll_data%avrSWAP( 1) + CALL CallBladedDLL(Turbine%SrvD%Input(1), Turbine%SrvD%p, Turbine%SrvD%m%dll_data, ErrStat2, ErrMsg2) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) ! put values back: - Turbine%SrvD%p%DLL_InFile = FileName + Turbine%SrvD%m%dll_data%DLL_InFile = FileName Turbine%SrvD%m%dll_data%avrSWAP(50) = REAL( LEN_TRIM(FileName) ) +1 ! No. of characters in the "INFILE" argument (-) (we add one for the C NULL CHARACTER) - Turbine%SrvD%m%dll_data%avrSWAP( 1) = old_avrSwap1 + Turbine%SrvD%m%dll_data%avrSWAP( 1) = old_avrSwap1 + Turbine%SrvD%m%dll_data%SimStatus = Turbine%SrvD%m%dll_data%avrSWAP( 1) end if end if @@ -6681,4 +6753,504 @@ SUBROUTINE FAST_RestoreFromCheckpoint_T(t_initial, n_t_global, NumTurbines, Turb END SUBROUTINE FAST_RestoreFromCheckpoint_T !---------------------------------------------------------------------------------------------------------------------------------- +!---------------------------------------------------------------------------------------------------------------------------------- +!> Routine that calls FAST_RestoreForVTKModeShape_T for an array of Turbine data structures. +SUBROUTINE FAST_RestoreForVTKModeShape_Tary(t_initial, Turbine, InputFileName, ErrStat, ErrMsg ) + + REAL(DbKi), INTENT(IN ) :: t_initial !< initial time (for comparing with time from checkpoint file) + TYPE(FAST_TurbineType), INTENT( OUT) :: Turbine(:) !< all data for one instance of a turbine + CHARACTER(*), INTENT(IN ) :: InputFileName !< Name of the input file + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! local variables + INTEGER(IntKi) :: i_turb + INTEGER(IntKi) :: n_t_global !< loop counter + INTEGER(IntKi) :: NumTurbines ! Number of turbines in this simulation + INTEGER(IntKi) :: ErrStat2 ! local error status + CHARACTER(ErrMsgLen) :: ErrMsg2 ! local error message + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_RestoreForVTKModeShape_Tary' + + + ErrStat = ErrID_None + ErrMsg = "" + + NumTurbines = SIZE(Turbine) + if (NumTurbines /=1) then + call SetErrStat(ErrID_Fatal, "Mode-shape visualization is not available for multiple turbines.", ErrStat, ErrMsg, RoutineName) + return + end if + + + CALL ReadModeShapeFile( Turbine(1)%p_FAST, trim(InputFileName), ErrStat2, ErrMsg2, checkpointOnly=.true. ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if (ErrStat >= AbortErrLev) return + + CALL FAST_RestoreFromCheckpoint_Tary( t_initial, n_t_global, Turbine, trim(Turbine(1)%p_FAST%VTK_modes%CheckpointRoot), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + + DO i_turb = 1,NumTurbines + if (.not. allocated(Turbine(i_turb)%m_FAST%Lin%LinTimes)) then + call SetErrStat(ErrID_Fatal, "Mode-shape visualization requires a checkpoint file from a simulation with linearization analysis, but NLinTimes is 0.", ErrStat, ErrMsg, RoutineName) + return + end if + + CALL FAST_RestoreForVTKModeShape_T(t_initial, Turbine(i_turb)%p_FAST, Turbine(i_turb)%y_FAST, Turbine(i_turb)%m_FAST, & + Turbine(i_turb)%ED, Turbine(i_turb)%BD, Turbine(i_turb)%SrvD, Turbine(i_turb)%AD14, Turbine(i_turb)%AD, Turbine(i_turb)%IfW, Turbine(i_turb)%OpFM, & + Turbine(i_turb)%HD, Turbine(i_turb)%SD, Turbine(i_turb)%ExtPtfm, Turbine(i_turb)%MAP, Turbine(i_turb)%FEAM, Turbine(i_turb)%MD, Turbine(i_turb)%Orca, & + Turbine(i_turb)%IceF, Turbine(i_turb)%IceD, Turbine(i_turb)%MeshMapData, trim(InputFileName), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + END DO + + +END SUBROUTINE FAST_RestoreForVTKModeShape_Tary + +!---------------------------------------------------------------------------------------------------------------------------------- +!> This routine calculates the motions generated by mode shapes and outputs VTK data for it +SUBROUTINE FAST_RestoreForVTKModeShape_T(t_initial, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, & + MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, InputFileName, ErrStat, ErrMsg ) + + REAL(DbKi), INTENT(IN ) :: t_initial !< initial time + + TYPE(FAST_ParameterType), INTENT(INOUT) :: p_FAST !< Parameters for the glue code + TYPE(FAST_OutputFileType),INTENT(INOUT) :: y_FAST !< Output variables for the glue code + TYPE(FAST_MiscVarType), INTENT(INOUT) :: m_FAST !< Miscellaneous variables + + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ED !< ElastoDyn data + TYPE(BeamDyn_Data), INTENT(INOUT) :: BD !< BeamDyn data + TYPE(ServoDyn_Data), INTENT(INOUT) :: SrvD !< ServoDyn data + TYPE(AeroDyn14_Data), INTENT(INOUT) :: AD14 !< AeroDyn14 data + TYPE(AeroDyn_Data), INTENT(INOUT) :: AD !< AeroDyn data + TYPE(InflowWind_Data), INTENT(INOUT) :: IfW !< InflowWind data + TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpFM !< OpenFOAM data + TYPE(HydroDyn_Data), INTENT(INOUT) :: HD !< HydroDyn data + TYPE(SubDyn_Data), INTENT(INOUT) :: SD !< SubDyn data + TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm !< ExtPtfm_MCKF data + TYPE(MAP_Data), INTENT(INOUT) :: MAPp !< MAP data + TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAM !< FEAMooring data + TYPE(MoorDyn_Data), INTENT(INOUT) :: MD !< Data for the MoorDyn module + TYPE(OrcaFlex_Data), INTENT(INOUT) :: Orca !< OrcaFlex interface data + TYPE(IceFloe_Data), INTENT(INOUT) :: IceF !< IceFloe data + TYPE(IceDyn_Data), INTENT(INOUT) :: IceD !< All the IceDyn data used in time-step loop + + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: MeshMapData !< Data for mapping between modules + CHARACTER(*), INTENT(IN ) :: InputFileName !< Name of the input file + + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + ! local variables + REAL(DbKi) :: dt ! time + REAL(DbKi) :: tprime ! time + INTEGER(IntKi) :: nt + + INTEGER(IntKi) :: iLinTime ! generic loop counters + INTEGER(IntKi) :: it ! generic loop counters + INTEGER(IntKi) :: iMode ! generic loop counters + INTEGER(IntKi) :: ModeNo ! mode number + INTEGER(IntKi) :: NLinTimes + + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_RestoreForVTKModeShape_T' + CHARACTER(1024) :: VTK_RootName + + + ErrStat = ErrID_None + ErrMsg = "" + + CALL ReadModeShapeFile( p_FAST, trim(InputFileName), ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if (ErrStat >= AbortErrLev) return + + call ReadModeShapeMatlabFile( p_FAST, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if (ErrStat >= AbortErrLev ) return + + y_FAST%WriteThisStep = .true. + y_FAST%UnSum = -1 + + NLinTimes = min( p_FAST%VTK_modes%VTKNLinTimes, size(p_FAST%VTK_modes%x_eig_magnitude,2), p_FAST%NLinTimes ) + + VTK_RootName = p_FAST%VTK_OutFileRoot + + select case (p_FAST%VTK_modes%VTKLinTim) + case (1) + + do iMode = 1,p_FAST%VTK_modes%VTKLinModes + ModeNo = p_FAST%VTK_modes%VTKModes(iMode) + + call GetTimeConstants(p_FAST%VTK_modes%DampedFreq_Hz(ModeNo), p_FAST%VTK_fps, nt, dt, p_FAST%VTK_tWidth ) + if (nt > 500) cycle + + p_FAST%VTK_OutFileRoot = trim(VTK_RootName)//'.Mode'//trim(num2lstr(ModeNo)) + y_FAST%VTK_count = 1 ! we are skipping the reference meshes by starting at 1 + do iLinTime = 1,NLinTimes + tprime = m_FAST%Lin%LinTimes(iLinTime) - m_FAST%Lin%LinTimes(1) + + if (p_FAST%DT_UJac < p_FAST%TMax) then + m_FAST%calcJacobian = .true. + m_FAST%NextJacCalcTime = m_FAST%Lin%LinTimes(iLinTime) + end if + + call SetOperatingPoint(iLinTime, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, ExtPtfm, & + MAPp, FEAM, MD, Orca, IceF, IceD, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! set perturbation of states based on x_eig magnitude and phase + call PerturbOP(tprime, iLinTime, ModeNo, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + IceF, IceD, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF (ErrStat >= AbortErrLev) RETURN + + CALL CalcOutputs_And_SolveForInputs( -1, m_FAST%Lin%LinTimes(iLinTime), STATE_CURR, m_FAST%calcJacobian, m_FAST%NextJacCalcTime, & + p_FAST, m_FAST, .true., ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF (ErrStat >= AbortErrLev) RETURN + + call WriteVTK(m_FAST%Lin%LinTimes(iLinTime), p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) + + end do ! iLinTime + end do ! iMode + + case (2) + + do iMode = 1,p_FAST%VTK_modes%VTKLinModes + ModeNo = p_FAST%VTK_modes%VTKModes(iMode) + + call GetTimeConstants(p_FAST%VTK_modes%DampedFreq_Hz(ModeNo), p_FAST%VTK_fps, nt, dt, p_FAST%VTK_tWidth ) + if (nt > 500) cycle + + do iLinTime = 1,NLinTimes + p_FAST%VTK_OutFileRoot = trim(VTK_RootName)//'.Mode'//trim(num2lstr(ModeNo))//'.LinTime'//trim(num2lstr(iLinTime)) + y_FAST%VTK_count = 1 ! we are skipping the reference meshes by starting at 1 + + if (p_FAST%DT_UJac < p_FAST%TMax) then + m_FAST%calcJacobian = .true. + m_FAST%NextJacCalcTime = m_FAST%Lin%LinTimes(iLinTime) + end if + + do it = 1,nt + tprime = (it-1)*dt + + call SetOperatingPoint(iLinTime, p_FAST, y_FAST, m_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, ExtPtfm, & + MAPp, FEAM, MD, Orca, IceF, IceD, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + ! set perturbation of states based on x_eig magnitude and phase + call PerturbOP(tprime, iLinTime, ModeNo, p_FAST, y_FAST, ED, BD, SrvD, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, & + IceF, IceD, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF (ErrStat >= AbortErrLev) RETURN + + CALL CalcOutputs_And_SolveForInputs( -1, m_FAST%Lin%LinTimes(iLinTime), STATE_CURR, m_FAST%calcJacobian, m_FAST%NextJacCalcTime, & + p_FAST, m_FAST, .true., ED, BD, SrvD, AD14, AD, IfW, OpFM, HD, SD, ExtPtfm, MAPp, FEAM, MD, Orca, IceF, IceD, MeshMapData, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF (ErrStat >= AbortErrLev) RETURN + + call WriteVTK(m_FAST%Lin%LinTimes(iLinTime)+tprime, p_FAST, y_FAST, MeshMapData, ED, BD, AD, IfW, OpFM, HD, SD, ExtPtfm, SrvD, MAPp, FEAM, MD, Orca, IceF, IceD) + + end do + + + end do ! iLinTime + end do ! iMode + + end select + +END SUBROUTINE FAST_RestoreForVTKModeShape_T +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE GetTimeConstants(DampedFreq_Hz, VTK_fps, nt, dt, VTK_tWidth ) + REAL(R8Ki), INTENT(IN ) :: DampedFreq_Hz + REAL(DbKi), INTENT(IN ) :: VTK_fps + INTEGER(IntKi), INTENT( OUT) :: nt !< number of steps + REAL(DbKi), INTENT( OUT) :: dt !< time step + INTEGER(IntKi), INTENT( OUT) :: VTK_tWidth + + REAL(DbKi) :: cycle_time ! time for one cycle of mode + INTEGER(IntKi) :: NCycles + INTEGER(IntKi), PARAMETER :: MinFrames = 5 + + if (DampedFreq_Hz <= 0.0_DbKi) then + nt = huge(nt) + dt = epsilon(dt) + VTK_tWidth = 1 + return + end if + + nt = 1 + NCycles = 0 + do while (nt= AbortErrLev) RETURN + + ! Process the requested data records of this file. + + CALL WrScr ( NewLine//' =======================================================' ) + CALL WrScr ( ' Reading in data from file "'//TRIM( p_FAST%VTK_modes%MatlabFileName )//'".'//NewLine ) + + + ! Read some of the header information. + + READ (UnIn, IOSTAT=ErrStat2) FileType ! placeholder for future file format changes + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat ( ErrID_Fatal, 'Fatal error reading FileType from file "'//TRIM( p_FAST%VTK_modes%MatlabFileName )//'".', ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + + READ (UnIn, IOSTAT=ErrStat2) nModes ! number of modes in the file + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat ( ErrID_Fatal, 'Fatal error reading nModes from file "'//TRIM( p_FAST%VTK_modes%MatlabFileName )//'".', ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + + READ (UnIn, IOSTAT=ErrStat2) nStates ! number of states in the file + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat ( ErrID_Fatal, 'Fatal error reading nStates from file "'//TRIM( p_FAST%VTK_modes%MatlabFileName )//'".', ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + + READ (UnIn, IOSTAT=ErrStat2) NLinTimes ! number of linearization times / azimuths in the file + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat ( ErrID_Fatal, 'Fatal error reading NLinTimes from file "'//TRIM( p_FAST%VTK_modes%MatlabFileName )//'".', ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + + ALLOCATE( p_FAST%VTK_Modes%NaturalFreq_Hz(nModes), & + p_FAST%VTK_Modes%DampingRatio( nModes), & + p_FAST%VTK_Modes%DampedFreq_Hz( nModes), STAT=ErrStat2 ) + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat ( ErrID_Fatal, 'Error allocating arrays to read from file.', ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + + + READ(UnIn, IOSTAT=ErrStat2) p_FAST%VTK_Modes%NaturalFreq_Hz ! read entire array + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat ( ErrID_Fatal, 'Fatal error reading NaturalFreq_Hz array from file "'//TRIM( p_FAST%VTK_modes%MatlabFileName )//'".', ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + + READ(UnIn, IOSTAT=ErrStat2) p_FAST%VTK_Modes%DampingRatio ! read entire array + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat ( ErrID_Fatal, 'Fatal error reading DampingRatio array from file "'//TRIM( p_FAST%VTK_modes%MatlabFileName )//'".', ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + + READ(UnIn, IOSTAT=ErrStat2) p_FAST%VTK_Modes%DampedFreq_Hz ! read entire array + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat ( ErrID_Fatal, 'Fatal error reading DampedFreq_Hz array from file "'//TRIM( p_FAST%VTK_modes%MatlabFileName )//'".', ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + + if (nModes < p_FAST%VTK_Modes%VTKLinModes) CALL SetErrStat(ErrID_Severe,'Number of modes requested exceeds the number of modes in the linearization analysis file "'//TRIM( p_FAST%VTK_modes%MatlabFileName )//'".', ErrStat, ErrMsg, RoutineName) + if (NLinTimes /= p_FAST%NLinTimes) CALL SetErrStat(ErrID_Severe,'Number of times linearization was performed is not the same as the number of linearization times in the linearization analysis file "'//TRIM( p_FAST%VTK_modes%MatlabFileName )//'".', ErrStat, ErrMsg, RoutineName) + + + !Let's read only the number of modes we need to use + nModes = min( nModes, p_FAST%VTK_Modes%VTKLinModes ) + + ALLOCATE( p_FAST%VTK_Modes%x_eig_magnitude(nStates, NLinTimes, nModes), & + p_FAST%VTK_Modes%x_eig_phase( nStates, NLinTimes, nModes), STAT=ErrStat2 ) + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat ( ErrID_Fatal, 'Error allocating arrays to read from file.', ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + + do iMode = 1,nModes + + READ(UnIn, IOSTAT=ErrStat2) p_FAST%VTK_Modes%x_eig_magnitude(:,:,iMode) ! read data for one mode + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat ( ErrID_Fatal, 'Fatal error reading x_eig_magnitude from file "'//TRIM( p_FAST%VTK_modes%MatlabFileName )//'".', ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + + READ(UnIn, IOSTAT=ErrStat2) p_FAST%VTK_Modes%x_eig_phase(:,:,iMode) ! read data for one mode + IF ( ErrStat2 /= 0 ) THEN + CALL SetErrStat ( ErrID_Fatal, 'Fatal error reading x_eig_phase from file "'//TRIM( p_FAST%VTK_modes%MatlabFileName )//'".', ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + + end do + +END SUBROUTINE ReadModeShapeMatlabFile +!---------------------------------------------------------------------------------------------------------------------------------- +SUBROUTINE ReadModeShapeFile(p_FAST, InputFile, ErrStat, ErrMsg, checkpointOnly) + TYPE(FAST_ParameterType), INTENT(INOUT) :: p_FAST !< Parameters for the glue code + CHARACTER(*), INTENT(IN ) :: InputFile !< Name of the text input file to read + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + LOGICAL, OPTIONAL, INTENT(IN ) :: checkpointOnly !< Whether to return after reading checkpoint file name + + ! local variables + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'ReadModeShapeFile' + + CHARACTER(1024) :: PriPath ! Path name of the primary file + INTEGER(IntKi) :: i + INTEGER(IntKi) :: UnIn + INTEGER(IntKi) :: UnEc + LOGICAL :: VTKLinTimes1 + + ErrStat = ErrID_None + ErrMsg = "" + UnEc = -1 + + CALL GetPath( InputFile, PriPath ) ! Input files will be relative to the path where the primary input file is located. + + ! Open data file. + CALL GetNewUnit( UnIn, ErrStat2, ErrMsg2 ) + + CALL OpenFInpFile ( UnIn, InputFile, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF (ErrStat >= AbortErrLev) RETURN + + + CALL ReadCom( UnIn, InputFile, 'File header: (line 1)', ErrStat2, ErrMsg2, UnEc ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL ReadCom( UnIn, InputFile, 'File header: (line 2)', ErrStat2, ErrMsg2, UnEc ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + !----------- FILE NAMES ---------------------------------------------------- + CALL ReadCom( UnIn, InputFile, 'Section Header: File Names', ErrStat2, ErrMsg2, UnEc ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL ReadVar( UnIn, InputFile, p_FAST%VTK_modes%CheckpointRoot, 'CheckpointRoot', 'Name of the checkpoint file written by FAST when linearization data was produced', ErrStat2, ErrMsg2, UnEc ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + IF ( PathIsRelative( p_FAST%VTK_modes%CheckpointRoot ) ) p_FAST%VTK_modes%CheckpointRoot = TRIM(PriPath)//TRIM(p_FAST%VTK_modes%CheckpointRoot) + + if (present(checkpointOnly)) then + if (checkpointOnly) then + call cleanup() + return + end if + end if + + + CALL ReadVar( UnIn, InputFile, p_FAST%VTK_modes%MatlabFileName, 'MatlabFileName', 'Name of the file with eigenvectors written by Matlab', ErrStat2, ErrMsg2, UnEc ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF ( ErrStat >= AbortErrLev ) THEN + CALL Cleanup() + RETURN + END IF + IF ( PathIsRelative( p_FAST%VTK_modes%MatlabFileName ) ) p_FAST%VTK_modes%MatlabFileName = TRIM(PriPath)//TRIM(p_FAST%VTK_modes%MatlabFileName) + + !----------- VISUALIZATION OPTIONS ------------------------------------------ + + CALL ReadCom( UnIn, InputFile, 'Section Header: Visualization Options', ErrStat2, ErrMsg2, UnEc ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL ReadVar( UnIn, InputFile, p_FAST%VTK_modes%VTKLinModes, 'VTKLinModes', 'Number of modes to visualize', ErrStat2, ErrMsg2, UnEc ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + + if (p_FAST%VTK_modes%VTKLinModes <= 0) CALL SetErrStat( ErrID_Fatal, "VTKLinModes must be a positive number.", ErrStat, ErrMsg, RoutineName ) + + if (ErrStat >= AbortErrLev) then + CALL Cleanup() + RETURN + end if + + + call AllocAry( p_FAST%VTK_modes%VTKModes, p_FAST%VTK_modes%VTKLinModes, 'VTKModes', ErrStat2, ErrMsg2) + call SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + if ( ErrStat >= AbortErrLev ) then + call Cleanup() + return + end if + + p_FAST%VTK_modes%VTKModes = -1 + + CALL ReadAry( UnIn, InputFile, p_FAST%VTK_modes%VTKModes, p_FAST%VTK_modes%VTKLinModes, 'VTKModes', 'List of modes to visualize', ErrStat2, ErrMsg2, UnEc ) + ! note that we don't check the ErrStat here; if the user entered fewer than p_FAST%VTK_modes%VTKLinModes values, we will use the + ! last entry to fill in remaining values. + !Check 1st value, we need at least one good value from user or throw error + IF (p_FAST%VTK_modes%VTKModes(1) < 0 ) THEN + call SetErrStat( ErrID_Fatal, "VTKModes must contain positive numbers.", ErrStat, ErrMsg, RoutineName ) + CALL CleanUp() + RETURN + ELSE + DO i = 2, p_FAST%VTK_modes%VTKLinModes + IF ( p_FAST%VTK_modes%VTKModes(i) < 0 ) THEN + p_FAST%VTK_modes%VTKModes(i)=p_FAST%VTK_modes%VTKModes(i-1) + 1 + ENDIF + ENDDO + ENDIF + + + CALL ReadVar( UnIn, InputFile, p_FAST%VTK_modes%VTKLinScale, 'VTKLinScale', 'Mode shape visualization scaling factor', ErrStat2, ErrMsg2, UnEc ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL ReadVar( UnIn, InputFile, p_FAST%VTK_modes%VTKLinTim, 'VTKLinTim', 'Switch to make one animation for all LinTimes together (1) or separate animations for each LinTimes(2)', ErrStat2, ErrMsg2, UnEc ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + CALL ReadVar( UnIn, InputFile, VTKLinTimes1, 'VTKLinTimes1', 'If VTKLinTim=2, visualize modes at LinTimes(1) only?', ErrStat2, ErrMsg2, UnEc ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + + CALL ReadVar( UnIn, InputFile, p_FAST%VTK_modes%VTKLinPhase, 'VTKLinPhase', 'Phase when making one animation for all LinTimes together (used only when VTKLinTim=1)', ErrStat2, ErrMsg2, UnEc ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + +! overwrite these based on inputs: + + if (p_FAST%VTK_modes%VTKLinTim == 2) then + p_FAST%VTK_modes%VTKLinPhase = 0 ! "Phase when making one animation for all LinTimes together (used only when VTKLinTim=1)" - + + if (VTKLinTimes1) then + p_FAST%VTK_modes%VTKNLinTimes = 1 + else + p_FAST%VTK_modes%VTKNLinTimes = p_FAST%NLinTimes + end if + else + p_FAST%VTK_modes%VTKNLinTimes = p_FAST%NLinTimes + end if + +contains + SUBROUTINE Cleanup() + IF (UnIn > 0) CLOSE(UnIn) + END SUBROUTINE Cleanup + +END SUBROUTINE ReadModeShapeFile +!---------------------------------------------------------------------------------------------------------------------------------- END MODULE FAST_Subs +!---------------------------------------------------------------------------------------------------------------------------------- diff --git a/modules/openfast-library/src/FAST_Types.f90 b/modules/openfast-library/src/FAST_Types.f90 index 47e0ba983d..db2c1df716 100644 --- a/modules/openfast-library/src/FAST_Types.f90 +++ b/modules/openfast-library/src/FAST_Types.f90 @@ -113,6 +113,23 @@ MODULE FAST_Types REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: MorisonRad !< radius of each Morison node [m] END TYPE FAST_VTK_SurfaceType ! ======================= +! ========= FAST_VTK_ModeShapeType ======= + TYPE, PUBLIC :: FAST_VTK_ModeShapeType + CHARACTER(1024) :: CheckpointRoot !< name of the checkpoint file written by FAST when linearization data was produced [-] + CHARACTER(1024) :: MatlabFileName !< name of the file with eigenvectors written by Matlab [-] + INTEGER(IntKi) :: VTKLinModes !< Number of modes to visualize [-] + INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: VTKModes !< Which modes to visualize [-] + INTEGER(IntKi) :: VTKLinTim !< Switch to make one animation for all LinTimes together (1) or separate animations for each LinTimes(2) [-] + INTEGER(IntKi) :: VTKNLinTimes !< number of linearization times to use when VTKLinTim==2 [-] + REAL(ReKi) :: VTKLinScale !< Mode shape visualization scaling factor [-] + REAL(ReKi) :: VTKLinPhase !< Phase when making one animation for all LinTimes together (used only when VTKLinTim=1) [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: DampingRatio !< damping ratios from mbc3 analysis [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: NaturalFreq_Hz !< natural frequency from mbc3 analysis [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: DampedFreq_Hz !< damped frequency from mbc3 analysis [-] + REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: x_eig_magnitude !< magnitude of eigenvector (dimension 1=state, dim 2= azimuth, dim 3 = mode) [-] + REAL(R8Ki) , DIMENSION(:,:,:), ALLOCATABLE :: x_eig_phase !< phase of eigenvector (dimension 1=state, dim 2= azimuth, dim 3 = mode) [-] + END TYPE FAST_VTK_ModeShapeType +! ======================= ! ========= FAST_ParameterType ======= TYPE, PUBLIC :: FAST_ParameterType REAL(DbKi) :: DT !< Integration time step [global time] [s] @@ -154,13 +171,14 @@ MODULE FAST_Types LOGICAL :: WrSttsTime !< Whether we should write the status times to the screen [-] INTEGER(IntKi) :: n_SttsTime !< Number of time steps between screen status messages [-] INTEGER(IntKi) :: n_ChkptTime !< Number of time steps between writing checkpoint files [-] + INTEGER(IntKi) :: n_DT_Out !< Number of time steps between writing a line in the time-marching output files [-] INTEGER(IntKi) :: n_VTKTime !< Number of time steps between writing VTK files [-] INTEGER(IntKi) :: TurbineType !< Type_LandBased, Type_Offshore_Fixed, or Type_Offshore_Floating [-] LOGICAL :: WrBinOutFile !< Write a binary output file? (.outb) [-] LOGICAL :: WrTxtOutFile !< Write a text (formatted) output file? (.out) [-] INTEGER(IntKi) :: WrBinMod !< If writing binary, which file format is to be written [1, 2, or 3] [-] LOGICAL :: SumPrint !< Print summary data to file? (.sum) [-] - INTEGER(IntKi) :: WrVTK !< VTK Visualization data output: (switch) {0=none; 1=initialization data only; 2=animation} [-] + INTEGER(IntKi) :: WrVTK = 0 !< VTK Visualization data output: (switch) {0=none; 1=initialization data only; 2=animation} [-] INTEGER(IntKi) :: VTK_Type !< Type of VTK visualization data: (switch) {1=surfaces; 2=basic meshes (lines/points); 3=all meshes (debug)} [-] LOGICAL :: VTK_fields !< Write mesh fields to VTK data files? (flag) {true/false} [-] CHARACTER(1) :: Delim !< Delimiter between columns of text output file (.out): space or tab [-] @@ -170,18 +188,98 @@ MODULE FAST_Types INTEGER(IntKi) :: TChanLen !< width of the time channel [-] CHARACTER(1024) :: OutFileRoot !< The rootname of the output files [-] CHARACTER(1024) :: FTitle !< The description line from the FAST (glue-code) input file [-] - REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: LinTimes !< List of times at which to linearize [s] + CHARACTER(1024) :: VTK_OutFileRoot = '' !< The rootname of the VTK output files [-] + INTEGER(IntKi) :: VTK_tWidth !< Width of number of files for leading zeros in file name format [-] + REAL(DbKi) :: VTK_fps !< number of frames per second to output VTK data [-] + TYPE(FAST_VTK_SurfaceType) :: VTK_surface !< Data for VTK surface visualization [-] + REAL(SiKi) , DIMENSION(1:3) :: TurbinePos !< Initial position of turbine base (origin used for graphics) [m] + CHARACTER(4) :: Tdesc !< description of turbine ID (for FAST.Farm) screen printing [-] + LOGICAL :: CalcSteady !< Calculate a steady-state periodic operating point before linearization [unused if Linearize=False] [-] + INTEGER(IntKi) :: TrimCase !< Controller parameter to be trimmed {1:yaw; 2:torque; 3:pitch} [unused if Linearize=False; used only if CalcSteady=True] [-] + REAL(ReKi) :: TrimTol !< Tolerance for the rotational speed convergence (>0) [unused if Linearize=False; used only if CalcSteady=True] [-] + REAL(ReKi) :: TrimGain !< Proportional gain for the rotational speed error (>0) [unused if Linearize=False; used only if CalcSteady=True] [rad/(rad/s) for yaw or pitch; Nm/(rad/s) for torque] + REAL(ReKi) :: Twr_Kdmp !< Damping factor for the tower [unused if Linearize=False; used only if CalcSteady=True] [N/(m/s)] + REAL(ReKi) :: Bld_Kdmp !< Damping factor for the blades [unused if Linearize=False; used only if CalcSteady=True] [N/(m/s)] + INTEGER(IntKi) :: NLinTimes !< Number of LinTimes, or equally-spaced azimuth steps in periodic linearized model (>0)[unused if Linearize=False] [-] + REAL(DbKi) :: AzimDelta !< difference between two consecutive azimuth positions in CalcSteady algorithm [rad] INTEGER(IntKi) :: LinInputs !< Inputs included in linearization (switch) {0=none; 1=standard; 2=all module inputs (debug)} [unused if Linearize=False] [-] INTEGER(IntKi) :: LinOutputs !< Outputs included in linearization (switch) {0=none; 1=from OutList(s); 2=all module outputs (debug)} [unused if Linearize=False] [-] LOGICAL :: LinOutJac !< Include full Jacabians in linearization output (for debug) (flag) [unused if Linearize=False; used only if LinInputs=LinOutputs=2] [-] LOGICAL :: LinOutMod !< Write module-level linearization output files in addition to output for full system? (flag) [unused if Linearize=False] [-] - TYPE(FAST_VTK_SurfaceType) :: VTK_surface !< Data for VTK surface visualization [-] - REAL(SiKi) , DIMENSION(1:3) :: TurbinePos !< Initial position of turbine base (origin used for graphics) [m] + TYPE(FAST_VTK_ModeShapeType) :: VTK_modes !< Data for VTK mode-shape visualization [-] INTEGER(IntKi) :: Lin_NumMods !< number of modules in the linearization [-] INTEGER(IntKi) , DIMENSION(NumModules) :: Lin_ModOrder !< indices that determine which order the modules are in the glue-code linearization matrix [-] - CHARACTER(4) :: Tdesc !< description of turbine ID (for FAST.Farm) screen printing [-] + INTEGER(IntKi) :: LinInterpOrder !< Interpolation order for CalcSteady solution [-] END TYPE FAST_ParameterType ! ======================= +! ========= FAST_LinStateSave ======= + TYPE, PUBLIC :: FAST_LinStateSave + TYPE(IceD_ContinuousStateType) , DIMENSION(:,:), ALLOCATABLE :: x_IceD !< Continuous states [-] + TYPE(IceD_DiscreteStateType) , DIMENSION(:,:), ALLOCATABLE :: xd_IceD !< Discrete states [-] + TYPE(IceD_ConstraintStateType) , DIMENSION(:,:), ALLOCATABLE :: z_IceD !< Constraint states [-] + TYPE(IceD_OtherStateType) , DIMENSION(:,:), ALLOCATABLE :: OtherSt_IceD !< Other states [-] + TYPE(IceD_InputType) , DIMENSION(:,:), ALLOCATABLE :: u_IceD !< System inputs [-] + TYPE(BD_ContinuousStateType) , DIMENSION(:,:), ALLOCATABLE :: x_BD !< Continuous states [-] + TYPE(BD_DiscreteStateType) , DIMENSION(:,:), ALLOCATABLE :: xd_BD !< Discrete states [-] + TYPE(BD_ConstraintStateType) , DIMENSION(:,:), ALLOCATABLE :: z_BD !< Constraint states [-] + TYPE(BD_OtherStateType) , DIMENSION(:,:), ALLOCATABLE :: OtherSt_BD !< Other states [-] + TYPE(BD_InputType) , DIMENSION(:,:), ALLOCATABLE :: u_BD !< System inputs [-] + TYPE(ED_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x_ED !< Continuous states [-] + TYPE(ED_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd_ED !< Discrete states [-] + TYPE(ED_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z_ED !< Constraint states [-] + TYPE(ED_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt_ED !< Other states [-] + TYPE(ED_InputType) , DIMENSION(:), ALLOCATABLE :: u_ED !< System inputs [-] + TYPE(SrvD_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x_SrvD !< Continuous states [-] + TYPE(SrvD_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd_SrvD !< Discrete states [-] + TYPE(SrvD_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z_SrvD !< Constraint states [-] + TYPE(SrvD_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt_SrvD !< Other states [-] + TYPE(SrvD_InputType) , DIMENSION(:), ALLOCATABLE :: u_SrvD !< System inputs [-] + TYPE(AD_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x_AD !< Continuous states [-] + TYPE(AD_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd_AD !< Discrete states [-] + TYPE(AD_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z_AD !< Constraint states [-] + TYPE(AD_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt_AD !< Other states [-] + TYPE(AD_InputType) , DIMENSION(:), ALLOCATABLE :: u_AD !< System inputs [-] + TYPE(InflowWind_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x_IfW !< Continuous states [-] + TYPE(InflowWind_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd_IfW !< Discrete states [-] + TYPE(InflowWind_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z_IfW !< Constraint states [-] + TYPE(InflowWind_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt_IfW !< Other states [-] + TYPE(InflowWind_InputType) , DIMENSION(:), ALLOCATABLE :: u_IfW !< System inputs [-] + TYPE(SD_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x_SD !< Continuous states [-] + TYPE(SD_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd_SD !< Discrete states [-] + TYPE(SD_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z_SD !< Constraint states [-] + TYPE(SD_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt_SD !< Other states [-] + TYPE(SD_InputType) , DIMENSION(:), ALLOCATABLE :: u_SD !< System inputs [-] + TYPE(ExtPtfm_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x_ExtPtfm !< Continuous states [-] + TYPE(ExtPtfm_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd_ExtPtfm !< Discrete states [-] + TYPE(ExtPtfm_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z_ExtPtfm !< Constraint states [-] + TYPE(ExtPtfm_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt_ExtPtfm !< Other states [-] + TYPE(ExtPtfm_InputType) , DIMENSION(:), ALLOCATABLE :: u_ExtPtfm !< System inputs [-] + TYPE(HydroDyn_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x_HD !< Continuous states [-] + TYPE(HydroDyn_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd_HD !< Discrete states [-] + TYPE(HydroDyn_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z_HD !< Constraint states [-] + TYPE(HydroDyn_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt_HD !< Other states [-] + TYPE(HydroDyn_InputType) , DIMENSION(:), ALLOCATABLE :: u_HD !< System inputs [-] + TYPE(IceFloe_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x_IceF !< Continuous states [-] + TYPE(IceFloe_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd_IceF !< Discrete states [-] + TYPE(IceFloe_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z_IceF !< Constraint states [-] + TYPE(IceFloe_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt_IceF !< Other states [-] + TYPE(IceFloe_InputType) , DIMENSION(:), ALLOCATABLE :: u_IceF !< System inputs [-] + TYPE(MAP_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x_MAP !< Continuous states [-] + TYPE(MAP_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd_MAP !< Discrete states [-] + TYPE(MAP_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z_MAP !< Constraint states [-] + TYPE(MAP_InputType) , DIMENSION(:), ALLOCATABLE :: u_MAP !< System inputs [-] + TYPE(FEAM_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x_FEAM !< Continuous states [-] + TYPE(FEAM_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd_FEAM !< Discrete states [-] + TYPE(FEAM_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z_FEAM !< Constraint states [-] + TYPE(FEAM_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt_FEAM !< Other states [-] + TYPE(FEAM_InputType) , DIMENSION(:), ALLOCATABLE :: u_FEAM !< System inputs [-] + TYPE(MD_ContinuousStateType) , DIMENSION(:), ALLOCATABLE :: x_MD !< Continuous states [-] + TYPE(MD_DiscreteStateType) , DIMENSION(:), ALLOCATABLE :: xd_MD !< Discrete states [-] + TYPE(MD_ConstraintStateType) , DIMENSION(:), ALLOCATABLE :: z_MD !< Constraint states [-] + TYPE(MD_OtherStateType) , DIMENSION(:), ALLOCATABLE :: OtherSt_MD !< Other states [-] + TYPE(MD_InputType) , DIMENSION(:), ALLOCATABLE :: u_MD !< System inputs [-] + END TYPE FAST_LinStateSave +! ======================= ! ========= FAST_LinType ======= TYPE, PUBLIC :: FAST_LinType CHARACTER(LinChanLen) , DIMENSION(:), ALLOCATABLE :: Names_u !< Names of the linearized inputs [-] @@ -195,6 +293,8 @@ MODULE FAST_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: op_dx !< 1st time derivative of continuous state operating point [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: op_xd !< discrete state operating point [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: op_z !< constraint state operating point [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: op_x_eig_mag !< continuous state eigenvector magnitude [-] + REAL(R8Ki) , DIMENSION(:), ALLOCATABLE :: op_x_eig_phase !< continuous state eigenvector phase [-] LOGICAL , DIMENSION(:), ALLOCATABLE :: Use_u !< array same size as names_u, which indicates if this input is used in linearization output file [-] LOGICAL , DIMENSION(:), ALLOCATABLE :: Use_y !< array same size as names_y, which indicates if this output is used in linearization output file [-] REAL(R8Ki) , DIMENSION(:,:), ALLOCATABLE :: A !< A matrix [-] @@ -225,9 +325,26 @@ MODULE FAST_Types TYPE(FAST_ModLinType) , DIMENSION(NumModules) :: Modules !< Linearization data for each module [-] TYPE(FAST_LinType) :: Glue !< Linearization data for the glue code (coupled system) [-] REAL(ReKi) :: RotSpeed !< Rotor azimuth angular speed [rad/s] - REAL(ReKi) :: Azimuth + REAL(ReKi) :: Azimuth !< Rotor azimuth position [rad] + REAL(ReKi) :: WindSpeed !< Wind speed at reference height [m/s] END TYPE FAST_LinFileType ! ======================= +! ========= FAST_MiscLinType ======= + TYPE, PUBLIC :: FAST_MiscLinType + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: LinTimes !< List of times at which to linearize [s] + INTEGER(IntKi) :: CopyOP_CtrlCode !< mesh control code for copy type (new on first call; update otherwise) [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: AzimTarget !< target azimuth positions in CalcSteady algorithm [rad] + LOGICAL :: IsConverged !< whether the error calculation in the CalcSteady algorithm is converged [-] + LOGICAL :: FoundSteady !< whether the CalcSteady algorithm found a steady-state solution [-] + INTEGER(IntKi) :: n_rot !< number of rotations completed in CalcSteady algorithm [-] + INTEGER(IntKi) :: AzimIndx !< index into target azimuth array in CalcSteady algorithm [-] + INTEGER(IntKi) :: NextLinTimeIndx !< index for next time in LinTimes where linearization should occur [-] + REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: Psi !< Azimuth angle at the current and previous time steps (uses LinInterpOrder); DbKi so that we can use registry-generated extrap/interp routines [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: y_interp !< Interpolated outputs packed into an array [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: y_ref !< Reference output range for CalcSteady error calculation [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Y_prevRot !< Linearization outputs from previous rotor revolution at each target azimuth [-] + END TYPE FAST_MiscLinType +! ======================= ! ========= FAST_OutputFileType ======= TYPE, PUBLIC :: FAST_OutputFileType REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: TimeData !< Array to contain the time output data for the binary file (first output time and a time [fixed] increment) [-] @@ -243,9 +360,13 @@ MODULE FAST_Types CHARACTER(ChanLen) , DIMENSION(:), ALLOCATABLE :: ChannelUnits !< Units for the output channels [-] TYPE(ProgDesc) , DIMENSION(NumModules) :: Module_Ver !< version information from all modules [-] CHARACTER(ChanLen) , DIMENSION(NumModules) :: Module_Abrev !< abbreviation for module (used in file output naming conventions) [-] + LOGICAL :: WriteThisStep !< Whether this step will be written in the FAST output files [-] INTEGER(IntKi) :: VTK_count !< Number of VTK files written (for naming output files) [-] INTEGER(IntKi) :: VTK_LastWaveIndx !< last index into wave array [-] TYPE(FAST_LinFileType) :: Lin !< linearization data for output [-] + INTEGER(IntKi) :: ActualChanLen !< width of the column headers output in the text and/or binary file [-] + CHARACTER(30) :: OutFmt_a !< Format used for text tabular output (except time); combines OutFmt with delim and appropriate spaces [-] + TYPE(FAST_LinStateSave) :: op !< operating points of states and inputs for VTK output of mode shapes [-] END TYPE FAST_OutputFileType ! ======================= ! ========= IceDyn_Data ======= @@ -272,6 +393,8 @@ MODULE FAST_Types TYPE(BD_InputType) , DIMENSION(:), ALLOCATABLE :: u !< System inputs [-] TYPE(BD_OutputType) , DIMENSION(:), ALLOCATABLE :: y !< System outputs [-] TYPE(BD_MiscVarType) , DIMENSION(:), ALLOCATABLE :: m !< Misc/optimization variables [-] + TYPE(BD_OutputType) , DIMENSION(:,:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] + TYPE(BD_OutputType) , DIMENSION(:), ALLOCATABLE :: y_interp !< interpolated system outputs for CalcSteady [-] TYPE(BD_InputType) , DIMENSION(:,:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:,:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] END TYPE BeamDyn_Data @@ -286,7 +409,8 @@ MODULE FAST_Types TYPE(ED_InputType) :: u !< System inputs [-] TYPE(ED_OutputType) :: y !< System outputs [-] TYPE(ED_MiscVarType) :: m !< Misc (optimization) variables not associated with time [-] - TYPE(ED_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with InputTimes [-] + TYPE(ED_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] + TYPE(ED_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] TYPE(ED_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] END TYPE ElastoDyn_Data @@ -301,6 +425,8 @@ MODULE FAST_Types TYPE(SrvD_InputType) :: u !< System inputs [-] TYPE(SrvD_OutputType) :: y !< System outputs [-] TYPE(SrvD_MiscVarType) :: m !< Misc (optimization) variables not associated with time [-] + TYPE(SrvD_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] + TYPE(SrvD_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] TYPE(SrvD_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] END TYPE ServoDyn_Data @@ -329,6 +455,8 @@ MODULE FAST_Types TYPE(AD_InputType) :: u !< System inputs [-] TYPE(AD_OutputType) :: y !< System outputs [-] TYPE(AD_MiscVarType) :: m !< Misc/optimization variables [-] + TYPE(AD_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] + TYPE(AD_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] TYPE(AD_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] END TYPE AeroDyn_Data @@ -343,6 +471,8 @@ MODULE FAST_Types TYPE(InflowWind_InputType) :: u !< System inputs [-] TYPE(InflowWind_OutputType) :: y !< System outputs [-] TYPE(InflowWind_MiscVarType) :: m !< Misc/optimization variables [-] + TYPE(InflowWind_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] + TYPE(InflowWind_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] TYPE(InflowWind_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] END TYPE InflowWind_Data @@ -400,6 +530,8 @@ MODULE FAST_Types TYPE(HydroDyn_InputType) :: u !< System inputs [-] TYPE(HydroDyn_OutputType) :: y !< System outputs [-] TYPE(HydroDyn_MiscVarType) :: m !< Misc/optimization variables [-] + TYPE(HydroDyn_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] + TYPE(HydroDyn_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] TYPE(HydroDyn_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] END TYPE HydroDyn_Data @@ -428,6 +560,8 @@ MODULE FAST_Types TYPE(MAP_InputType) :: u !< System inputs [-] TYPE(MAP_OutputType) :: y !< System outputs [-] TYPE(MAP_OtherStateType) :: OtherSt_old !< Other/optimization states (copied for the case of subcycling) [-] + TYPE(MAP_OutputType) , DIMENSION(:), ALLOCATABLE :: Output !< Array of outputs associated with CalcSteady Azimuths [-] + TYPE(MAP_OutputType) :: y_interp !< interpolated system outputs for CalcSteady [-] TYPE(MAP_InputType) , DIMENSION(:), ALLOCATABLE :: Input !< Array of inputs associated with InputTimes [-] REAL(DbKi) , DIMENSION(:), ALLOCATABLE :: InputTimes !< Array of times associated with Input Array [-] END TYPE MAP_Data @@ -508,7 +642,7 @@ MODULE FAST_Types TYPE(MeshMapType) :: SD_P_2_IceF_P !< Map SubDyn y2Mesh point mesh to IceFloe point mesh [-] TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: IceD_P_2_SD_P !< Map IceDyn point mesh to SubDyn y2Mesh point mesh [-] TYPE(MeshMapType) , DIMENSION(:), ALLOCATABLE :: SD_P_2_IceD_P !< Map SubDyn y2Mesh point mesh to IceDyn point mesh [-] - REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Jacobian_Opt1 !< Stored Jacobian in ED_HD_InputOutputSolve or ED_SD_HD_BD_InputOutputSolve [-] + REAL(ReKi) , DIMENSION(:,:), ALLOCATABLE :: Jacobian_Opt1 !< Stored Jacobian in ED_HD_InputOutputSolve or FullOpt1_InputOutputSolve [-] INTEGER(IntKi) , DIMENSION(:), ALLOCATABLE :: Jacobian_pivot !< Pivot array used for LU decomposition of Jacobian_Opt1 [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Jac_u_indx !< matrix to help fill/pack the u vector in computing the jacobian [-] TYPE(MeshType) :: u_ED_PlatformPtMesh !< copy of ED input mesh [-] @@ -533,11 +667,49 @@ MODULE FAST_Types REAL(ReKi) :: ElecPwr !< electric power input from Simulink/Labview [-] REAL(ReKi) :: YawPosCom !< yaw position command from Simulink/Labview [-] REAL(ReKi) :: YawRateCom !< yaw rate command from Simulink/Labview [-] - REAL(ReKi) , DIMENSION(1:3) :: BlPitchCom !< blade pitch commands from Simulink/Labview [rad/s] + REAL(ReKi) , DIMENSION(1:3) :: BlPitchCom !< blade pitch commands from Simulink/Labview [rad] REAL(ReKi) :: HSSBrFrac !< Fraction of full braking torque: 0 (off) <= HSSBrFrac <= 1 (full) from Simulink or LabVIEW [-] REAL(ReKi) , DIMENSION(1:3) :: LidarFocus !< lidar focus (relative to lidar location) [m] END TYPE FAST_ExternInputType ! ======================= +! ========= FAST_InitData ======= + TYPE, PUBLIC :: FAST_InitData + TYPE(ED_InitInputType) :: InData_ED !< ED Initialization input data [-] + TYPE(ED_InitOutputType) :: OutData_ED !< ED Initialization output data [-] + TYPE(BD_InitInputType) :: InData_BD !< BD Initialization input data [-] + TYPE(BD_InitOutputType) , DIMENSION(:), ALLOCATABLE :: OutData_BD !< BD Initialization output data [-] + TYPE(SrvD_InitInputType) :: InData_SrvD !< SrvD Initialization input data [-] + TYPE(SrvD_InitOutputType) :: OutData_SrvD !< SrvD Initialization output data [-] + TYPE(AD14_InitInputType) :: InData_AD14 !< AD14 Initialization input data [-] + TYPE(AD14_InitOutputType) :: OutData_AD14 !< AD14 Initialization output data [-] + TYPE(AD_InitInputType) :: InData_AD !< AD Initialization input data [-] + TYPE(AD_InitOutputType) :: OutData_AD !< AD Initialization output data [-] + TYPE(InflowWind_InitInputType) :: InData_IfW !< IfW Initialization input data [-] + TYPE(InflowWind_InitOutputType) :: OutData_IfW !< IfW Initialization output data [-] + TYPE(OpFM_InitInputType) :: InData_OpFM !< OpFM Initialization input data [-] + TYPE(OpFM_InitOutputType) :: OutData_OpFM !< OpFM Initialization output data [-] + TYPE(HydroDyn_InitInputType) :: InData_HD !< HD Initialization input data [-] + TYPE(HydroDyn_InitOutputType) :: OutData_HD !< HD Initialization output data [-] + TYPE(SD_InitInputType) :: InData_SD !< SD Initialization input data [-] + TYPE(SD_InitOutputType) :: OutData_SD !< SD Initialization output data [-] + TYPE(ExtPtfm_InitInputType) :: InData_ExtPtfm !< ExtPtfm Initialization input data [-] + TYPE(ExtPtfm_InitOutputType) :: OutData_ExtPtfm !< ExtPtfm Initialization output data [-] + TYPE(MAP_InitInputType) :: InData_MAP !< MAP Initialization input data [-] + TYPE(MAP_InitOutputType) :: OutData_MAP !< MAP Initialization output data [-] + TYPE(FEAM_InitInputType) :: InData_FEAM !< FEAM Initialization input data [-] + TYPE(FEAM_InitOutputType) :: OutData_FEAM !< FEAM Initialization output data [-] + TYPE(MD_InitInputType) :: InData_MD !< MD Initialization input data [-] + TYPE(MD_InitOutputType) :: OutData_MD !< MD Initialization output data [-] + TYPE(Orca_InitInputType) :: InData_Orca !< Orca Initialization input data [-] + TYPE(Orca_InitOutputType) :: OutData_Orca !< Orca Initialization output data [-] + TYPE(IceFloe_InitInputType) :: InData_IceF !< IceF Initialization input data [-] + TYPE(IceFloe_InitOutputType) :: OutData_IceF !< IceF Initialization output data [-] + TYPE(IceD_InitInputType) :: InData_IceD !< IceD Initialization input data [-] + TYPE(IceD_InitOutputType) :: OutData_IceD !< IceD Initialization output data (each instance will have the same output channels) [-] + TYPE(SC_InitInputType) :: InData_SC !< SC Initialization input data [-] + TYPE(SC_InitOutputType) :: OutData_SC !< SC Initialization output data [-] + END TYPE FAST_InitData +! ======================= ! ========= FAST_MiscVarType ======= TYPE, PUBLIC :: FAST_MiscVarType REAL(DbKi) :: TiLstPrn !< The simulation time of the last print (to file) [(s)] @@ -550,7 +722,7 @@ MODULE FAST_Types INTEGER(IntKi) , DIMENSION(1:8) :: SimStrtTime !< Start time of simulation (after initialization) [-] LOGICAL :: calcJacobian !< Should we calculate Jacobians in Option 1? [(flag)] TYPE(FAST_ExternInputType) :: ExternInput !< external input values [-] - INTEGER(IntKi) :: NextLinTimeIndx !< index for next time in LinTimes where linearization should occur [-] + TYPE(FAST_MiscLinType) :: Lin !< misc data for linearization analysis [-] END TYPE FAST_MiscVarType ! ======================= ! ========= FAST_ExternInitType ======= @@ -730,8 +902,14 @@ SUBROUTINE FAST_PackVTK_BLSurfaceType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrSt IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AirfoilCoords,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AirfoilCoords)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AirfoilCoords))-1 ) = PACK(InData%AirfoilCoords,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AirfoilCoords) + DO i3 = LBOUND(InData%AirfoilCoords,3), UBOUND(InData%AirfoilCoords,3) + DO i2 = LBOUND(InData%AirfoilCoords,2), UBOUND(InData%AirfoilCoords,2) + DO i1 = LBOUND(InData%AirfoilCoords,1), UBOUND(InData%AirfoilCoords,1) + ReKiBuf(Re_Xferred) = InData%AirfoilCoords(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF END SUBROUTINE FAST_PackVTK_BLSurfaceType @@ -748,12 +926,6 @@ SUBROUTINE FAST_UnPackVTK_BLSurfaceType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (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 @@ -789,15 +961,14 @@ SUBROUTINE FAST_UnPackVTK_BLSurfaceType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AirfoilCoords.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%AirfoilCoords)>0) OutData%AirfoilCoords = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AirfoilCoords))-1 ), mask3, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%AirfoilCoords) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%AirfoilCoords,3), UBOUND(OutData%AirfoilCoords,3) + DO i2 = LBOUND(OutData%AirfoilCoords,2), UBOUND(OutData%AirfoilCoords,2) + DO i1 = LBOUND(OutData%AirfoilCoords,1), UBOUND(OutData%AirfoilCoords,1) + OutData%AirfoilCoords(i1,i2,i3) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF END SUBROUTINE FAST_UnPackVTK_BLSurfaceType @@ -1032,14 +1203,18 @@ SUBROUTINE FAST_PackVTK_SurfaceType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumSectors - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HubRad - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GroundRad - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%NacelleBox))-1 ) = PACK(InData%NacelleBox,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%NacelleBox) + IntKiBuf(Int_Xferred) = InData%NumSectors + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HubRad + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GroundRad + Re_Xferred = Re_Xferred + 1 + DO i2 = LBOUND(InData%NacelleBox,2), UBOUND(InData%NacelleBox,2) + DO i1 = LBOUND(InData%NacelleBox,1), UBOUND(InData%NacelleBox,1) + ReKiBuf(Re_Xferred) = InData%NacelleBox(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO IF ( .NOT. ALLOCATED(InData%TowerRad) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1050,11 +1225,15 @@ SUBROUTINE FAST_PackVTK_SurfaceType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TowerRad,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TowerRad)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TowerRad))-1 ) = PACK(InData%TowerRad,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TowerRad) + DO i1 = LBOUND(InData%TowerRad,1), UBOUND(InData%TowerRad,1) + ReKiBuf(Re_Xferred) = InData%TowerRad(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%NWaveElevPts))-1 ) = PACK(InData%NWaveElevPts,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%NWaveElevPts) + DO i1 = LBOUND(InData%NWaveElevPts,1), UBOUND(InData%NWaveElevPts,1) + IntKiBuf(Int_Xferred) = InData%NWaveElevPts(i1) + Int_Xferred = Int_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%WaveElevXY) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1068,8 +1247,12 @@ SUBROUTINE FAST_PackVTK_SurfaceType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElevXY,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElevXY)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElevXY))-1 ) = PACK(InData%WaveElevXY,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElevXY) + DO i2 = LBOUND(InData%WaveElevXY,2), UBOUND(InData%WaveElevXY,2) + DO i1 = LBOUND(InData%WaveElevXY,1), UBOUND(InData%WaveElevXY,1) + ReKiBuf(Re_Xferred) = InData%WaveElevXY(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%WaveElev) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1084,8 +1267,12 @@ SUBROUTINE FAST_PackVTK_SurfaceType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WaveElev,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WaveElev)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WaveElev))-1 ) = PACK(InData%WaveElev,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WaveElev) + DO i2 = LBOUND(InData%WaveElev,2), UBOUND(InData%WaveElev,2) + DO i1 = LBOUND(InData%WaveElev,1), UBOUND(InData%WaveElev,1) + ReKiBuf(Re_Xferred) = InData%WaveElev(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%BladeShape) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1138,8 +1325,10 @@ SUBROUTINE FAST_PackVTK_SurfaceType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MorisonRad,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%MorisonRad)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MorisonRad))-1 ) = PACK(InData%MorisonRad,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MorisonRad) + DO i1 = LBOUND(InData%MorisonRad,1), UBOUND(InData%MorisonRad,1) + ReKiBuf(Re_Xferred) = InData%MorisonRad(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE FAST_PackVTK_SurfaceType @@ -1156,12 +1345,6 @@ SUBROUTINE FAST_UnPackVTK_SurfaceType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -1177,25 +1360,22 @@ SUBROUTINE FAST_UnPackVTK_SurfaceType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%NumSectors = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%HubRad = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 - OutData%GroundRad = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%NumSectors = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%HubRad = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + OutData%GroundRad = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%NacelleBox,1) i1_u = UBOUND(OutData%NacelleBox,1) i2_l = LBOUND(OutData%NacelleBox,2) i2_u = UBOUND(OutData%NacelleBox,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%NacelleBox = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%NacelleBox))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%NacelleBox) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%NacelleBox,2), UBOUND(OutData%NacelleBox,2) + DO i1 = LBOUND(OutData%NacelleBox,1), UBOUND(OutData%NacelleBox,1) + OutData%NacelleBox(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TowerRad not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1209,27 +1389,17 @@ SUBROUTINE FAST_UnPackVTK_SurfaceType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TowerRad.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TowerRad)>0) OutData%TowerRad = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TowerRad))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%TowerRad) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TowerRad,1), UBOUND(OutData%TowerRad,1) + OutData%TowerRad(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF i1_l = LBOUND(OutData%NWaveElevPts,1) i1_u = UBOUND(OutData%NWaveElevPts,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%NWaveElevPts = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%NWaveElevPts))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%NWaveElevPts) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%NWaveElevPts,1), UBOUND(OutData%NWaveElevPts,1) + OutData%NWaveElevPts(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElevXY not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1246,15 +1416,12 @@ SUBROUTINE FAST_UnPackVTK_SurfaceType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElevXY.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveElevXY)>0) OutData%WaveElevXY = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElevXY))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElevXY) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveElevXY,2), UBOUND(OutData%WaveElevXY,2) + DO i1 = LBOUND(OutData%WaveElevXY,1), UBOUND(OutData%WaveElevXY,1) + OutData%WaveElevXY(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WaveElev not allocated Int_Xferred = Int_Xferred + 1 @@ -1272,15 +1439,12 @@ SUBROUTINE FAST_UnPackVTK_SurfaceType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WaveElev.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%WaveElev)>0) OutData%WaveElev = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WaveElev))-1 ), mask2, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%WaveElev) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%WaveElev,2), UBOUND(OutData%WaveElev,2) + DO i1 = LBOUND(OutData%WaveElev,1), UBOUND(OutData%WaveElev,1) + OutData%WaveElev(i1,i2) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BladeShape not allocated Int_Xferred = Int_Xferred + 1 @@ -1351,17 +1515,553 @@ SUBROUTINE FAST_UnPackVTK_SurfaceType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MorisonRad.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) + DO i1 = LBOUND(OutData%MorisonRad,1), UBOUND(OutData%MorisonRad,1) + OutData%MorisonRad(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + END SUBROUTINE FAST_UnPackVTK_SurfaceType + + SUBROUTINE FAST_CopyVTK_ModeShapeType( SrcVTK_ModeShapeTypeData, DstVTK_ModeShapeTypeData, CtrlCode, ErrStat, ErrMsg ) + TYPE(FAST_VTK_ModeShapeType), INTENT(IN) :: SrcVTK_ModeShapeTypeData + TYPE(FAST_VTK_ModeShapeType), INTENT(INOUT) :: DstVTK_ModeShapeTypeData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyVTK_ModeShapeType' +! + ErrStat = ErrID_None + ErrMsg = "" + DstVTK_ModeShapeTypeData%CheckpointRoot = SrcVTK_ModeShapeTypeData%CheckpointRoot + DstVTK_ModeShapeTypeData%MatlabFileName = SrcVTK_ModeShapeTypeData%MatlabFileName + DstVTK_ModeShapeTypeData%VTKLinModes = SrcVTK_ModeShapeTypeData%VTKLinModes +IF (ALLOCATED(SrcVTK_ModeShapeTypeData%VTKModes)) THEN + i1_l = LBOUND(SrcVTK_ModeShapeTypeData%VTKModes,1) + i1_u = UBOUND(SrcVTK_ModeShapeTypeData%VTKModes,1) + IF (.NOT. ALLOCATED(DstVTK_ModeShapeTypeData%VTKModes)) THEN + ALLOCATE(DstVTK_ModeShapeTypeData%VTKModes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%VTKModes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstVTK_ModeShapeTypeData%VTKModes = SrcVTK_ModeShapeTypeData%VTKModes +ENDIF + DstVTK_ModeShapeTypeData%VTKLinTim = SrcVTK_ModeShapeTypeData%VTKLinTim + DstVTK_ModeShapeTypeData%VTKNLinTimes = SrcVTK_ModeShapeTypeData%VTKNLinTimes + DstVTK_ModeShapeTypeData%VTKLinScale = SrcVTK_ModeShapeTypeData%VTKLinScale + DstVTK_ModeShapeTypeData%VTKLinPhase = SrcVTK_ModeShapeTypeData%VTKLinPhase +IF (ALLOCATED(SrcVTK_ModeShapeTypeData%DampingRatio)) THEN + i1_l = LBOUND(SrcVTK_ModeShapeTypeData%DampingRatio,1) + i1_u = UBOUND(SrcVTK_ModeShapeTypeData%DampingRatio,1) + IF (.NOT. ALLOCATED(DstVTK_ModeShapeTypeData%DampingRatio)) THEN + ALLOCATE(DstVTK_ModeShapeTypeData%DampingRatio(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%DampingRatio.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstVTK_ModeShapeTypeData%DampingRatio = SrcVTK_ModeShapeTypeData%DampingRatio +ENDIF +IF (ALLOCATED(SrcVTK_ModeShapeTypeData%NaturalFreq_Hz)) THEN + i1_l = LBOUND(SrcVTK_ModeShapeTypeData%NaturalFreq_Hz,1) + i1_u = UBOUND(SrcVTK_ModeShapeTypeData%NaturalFreq_Hz,1) + IF (.NOT. ALLOCATED(DstVTK_ModeShapeTypeData%NaturalFreq_Hz)) THEN + ALLOCATE(DstVTK_ModeShapeTypeData%NaturalFreq_Hz(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%NaturalFreq_Hz.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstVTK_ModeShapeTypeData%NaturalFreq_Hz = SrcVTK_ModeShapeTypeData%NaturalFreq_Hz +ENDIF +IF (ALLOCATED(SrcVTK_ModeShapeTypeData%DampedFreq_Hz)) THEN + i1_l = LBOUND(SrcVTK_ModeShapeTypeData%DampedFreq_Hz,1) + i1_u = UBOUND(SrcVTK_ModeShapeTypeData%DampedFreq_Hz,1) + IF (.NOT. ALLOCATED(DstVTK_ModeShapeTypeData%DampedFreq_Hz)) THEN + ALLOCATE(DstVTK_ModeShapeTypeData%DampedFreq_Hz(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%DampedFreq_Hz.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstVTK_ModeShapeTypeData%DampedFreq_Hz = SrcVTK_ModeShapeTypeData%DampedFreq_Hz +ENDIF +IF (ALLOCATED(SrcVTK_ModeShapeTypeData%x_eig_magnitude)) THEN + i1_l = LBOUND(SrcVTK_ModeShapeTypeData%x_eig_magnitude,1) + i1_u = UBOUND(SrcVTK_ModeShapeTypeData%x_eig_magnitude,1) + i2_l = LBOUND(SrcVTK_ModeShapeTypeData%x_eig_magnitude,2) + i2_u = UBOUND(SrcVTK_ModeShapeTypeData%x_eig_magnitude,2) + i3_l = LBOUND(SrcVTK_ModeShapeTypeData%x_eig_magnitude,3) + i3_u = UBOUND(SrcVTK_ModeShapeTypeData%x_eig_magnitude,3) + IF (.NOT. ALLOCATED(DstVTK_ModeShapeTypeData%x_eig_magnitude)) THEN + ALLOCATE(DstVTK_ModeShapeTypeData%x_eig_magnitude(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%x_eig_magnitude.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstVTK_ModeShapeTypeData%x_eig_magnitude = SrcVTK_ModeShapeTypeData%x_eig_magnitude +ENDIF +IF (ALLOCATED(SrcVTK_ModeShapeTypeData%x_eig_phase)) THEN + i1_l = LBOUND(SrcVTK_ModeShapeTypeData%x_eig_phase,1) + i1_u = UBOUND(SrcVTK_ModeShapeTypeData%x_eig_phase,1) + i2_l = LBOUND(SrcVTK_ModeShapeTypeData%x_eig_phase,2) + i2_u = UBOUND(SrcVTK_ModeShapeTypeData%x_eig_phase,2) + i3_l = LBOUND(SrcVTK_ModeShapeTypeData%x_eig_phase,3) + i3_u = UBOUND(SrcVTK_ModeShapeTypeData%x_eig_phase,3) + IF (.NOT. ALLOCATED(DstVTK_ModeShapeTypeData%x_eig_phase)) THEN + ALLOCATE(DstVTK_ModeShapeTypeData%x_eig_phase(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstVTK_ModeShapeTypeData%x_eig_phase.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstVTK_ModeShapeTypeData%x_eig_phase = SrcVTK_ModeShapeTypeData%x_eig_phase +ENDIF + END SUBROUTINE FAST_CopyVTK_ModeShapeType + + SUBROUTINE FAST_DestroyVTK_ModeShapeType( VTK_ModeShapeTypeData, ErrStat, ErrMsg ) + TYPE(FAST_VTK_ModeShapeType), INTENT(INOUT) :: VTK_ModeShapeTypeData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyVTK_ModeShapeType' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(VTK_ModeShapeTypeData%VTKModes)) THEN + DEALLOCATE(VTK_ModeShapeTypeData%VTKModes) +ENDIF +IF (ALLOCATED(VTK_ModeShapeTypeData%DampingRatio)) THEN + DEALLOCATE(VTK_ModeShapeTypeData%DampingRatio) +ENDIF +IF (ALLOCATED(VTK_ModeShapeTypeData%NaturalFreq_Hz)) THEN + DEALLOCATE(VTK_ModeShapeTypeData%NaturalFreq_Hz) +ENDIF +IF (ALLOCATED(VTK_ModeShapeTypeData%DampedFreq_Hz)) THEN + DEALLOCATE(VTK_ModeShapeTypeData%DampedFreq_Hz) +ENDIF +IF (ALLOCATED(VTK_ModeShapeTypeData%x_eig_magnitude)) THEN + DEALLOCATE(VTK_ModeShapeTypeData%x_eig_magnitude) +ENDIF +IF (ALLOCATED(VTK_ModeShapeTypeData%x_eig_phase)) THEN + DEALLOCATE(VTK_ModeShapeTypeData%x_eig_phase) +ENDIF + END SUBROUTINE FAST_DestroyVTK_ModeShapeType + + SUBROUTINE FAST_PackVTK_ModeShapeType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(FAST_VTK_ModeShapeType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackVTK_ModeShapeType' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1*LEN(InData%CheckpointRoot) ! CheckpointRoot + Int_BufSz = Int_BufSz + 1*LEN(InData%MatlabFileName) ! MatlabFileName + Int_BufSz = Int_BufSz + 1 ! VTKLinModes + Int_BufSz = Int_BufSz + 1 ! VTKModes allocated yes/no + IF ( ALLOCATED(InData%VTKModes) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! VTKModes upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%VTKModes) ! VTKModes + END IF + Int_BufSz = Int_BufSz + 1 ! VTKLinTim + Int_BufSz = Int_BufSz + 1 ! VTKNLinTimes + Re_BufSz = Re_BufSz + 1 ! VTKLinScale + Re_BufSz = Re_BufSz + 1 ! VTKLinPhase + Int_BufSz = Int_BufSz + 1 ! DampingRatio allocated yes/no + IF ( ALLOCATED(InData%DampingRatio) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! DampingRatio upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%DampingRatio) ! DampingRatio + END IF + Int_BufSz = Int_BufSz + 1 ! NaturalFreq_Hz allocated yes/no + IF ( ALLOCATED(InData%NaturalFreq_Hz) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! NaturalFreq_Hz upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%NaturalFreq_Hz) ! NaturalFreq_Hz + END IF + Int_BufSz = Int_BufSz + 1 ! DampedFreq_Hz allocated yes/no + IF ( ALLOCATED(InData%DampedFreq_Hz) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! DampedFreq_Hz upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%DampedFreq_Hz) ! DampedFreq_Hz + END IF + Int_BufSz = Int_BufSz + 1 ! x_eig_magnitude allocated yes/no + IF ( ALLOCATED(InData%x_eig_magnitude) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! x_eig_magnitude upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%x_eig_magnitude) ! x_eig_magnitude + END IF + Int_BufSz = Int_BufSz + 1 ! x_eig_phase allocated yes/no + IF ( ALLOCATED(InData%x_eig_phase) ) THEN + Int_BufSz = Int_BufSz + 2*3 ! x_eig_phase upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%x_eig_phase) ! x_eig_phase + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + DO I = 1, LEN(InData%CheckpointRoot) + IntKiBuf(Int_Xferred) = ICHAR(InData%CheckpointRoot(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%MatlabFileName) + IntKiBuf(Int_Xferred) = ICHAR(InData%MatlabFileName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%VTKLinModes + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%VTKModes) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%VTKModes,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%VTKModes,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%VTKModes,1), UBOUND(InData%VTKModes,1) + IntKiBuf(Int_Xferred) = InData%VTKModes(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IntKiBuf(Int_Xferred) = InData%VTKLinTim + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%VTKNLinTimes + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VTKLinScale + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VTKLinPhase + Re_Xferred = Re_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%DampingRatio) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%DampingRatio,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DampingRatio,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%DampingRatio,1), UBOUND(InData%DampingRatio,1) + DbKiBuf(Db_Xferred) = InData%DampingRatio(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%NaturalFreq_Hz) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%NaturalFreq_Hz,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NaturalFreq_Hz,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%NaturalFreq_Hz,1), UBOUND(InData%NaturalFreq_Hz,1) + DbKiBuf(Db_Xferred) = InData%NaturalFreq_Hz(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%DampedFreq_Hz) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%DampedFreq_Hz,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DampedFreq_Hz,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%DampedFreq_Hz,1), UBOUND(InData%DampedFreq_Hz,1) + DbKiBuf(Db_Xferred) = InData%DampedFreq_Hz(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%x_eig_magnitude) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%x_eig_magnitude,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_eig_magnitude,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%x_eig_magnitude,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_eig_magnitude,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%x_eig_magnitude,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_eig_magnitude,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%x_eig_magnitude,3), UBOUND(InData%x_eig_magnitude,3) + DO i2 = LBOUND(InData%x_eig_magnitude,2), UBOUND(InData%x_eig_magnitude,2) + DO i1 = LBOUND(InData%x_eig_magnitude,1), UBOUND(InData%x_eig_magnitude,1) + DbKiBuf(Db_Xferred) = InData%x_eig_magnitude(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%x_eig_phase) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%x_eig_phase,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_eig_phase,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%x_eig_phase,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_eig_phase,2) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%x_eig_phase,3) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_eig_phase,3) + Int_Xferred = Int_Xferred + 2 + + DO i3 = LBOUND(InData%x_eig_phase,3), UBOUND(InData%x_eig_phase,3) + DO i2 = LBOUND(InData%x_eig_phase,2), UBOUND(InData%x_eig_phase,2) + DO i1 = LBOUND(InData%x_eig_phase,1), UBOUND(InData%x_eig_phase,1) + DbKiBuf(Db_Xferred) = InData%x_eig_phase(i1,i2,i3) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END IF + END SUBROUTINE FAST_PackVTK_ModeShapeType + + SUBROUTINE FAST_UnPackVTK_ModeShapeType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(FAST_VTK_ModeShapeType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: i3, i3_l, i3_u ! bounds (upper/lower) for an array dimension 3 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackVTK_ModeShapeType' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + DO I = 1, LEN(OutData%CheckpointRoot) + OutData%CheckpointRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%MatlabFileName) + OutData%MatlabFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%VTKLinModes = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! VTKModes not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%VTKModes)) DEALLOCATE(OutData%VTKModes) + ALLOCATE(OutData%VTKModes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%VTKModes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%VTKModes,1), UBOUND(OutData%VTKModes,1) + OutData%VTKModes(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + OutData%VTKLinTim = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%VTKNLinTimes = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%VTKLinScale = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%VTKLinPhase = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DampingRatio not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%DampingRatio)) DEALLOCATE(OutData%DampingRatio) + ALLOCATE(OutData%DampingRatio(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DampingRatio.', ErrStat, ErrMsg,RoutineName) RETURN END IF - mask1 = .TRUE. - IF (SIZE(OutData%MorisonRad)>0) OutData%MorisonRad = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MorisonRad))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%MorisonRad) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%DampingRatio,1), UBOUND(OutData%DampingRatio,1) + OutData%DampingRatio(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO END IF - END SUBROUTINE FAST_UnPackVTK_SurfaceType + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NaturalFreq_Hz not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%NaturalFreq_Hz)) DEALLOCATE(OutData%NaturalFreq_Hz) + ALLOCATE(OutData%NaturalFreq_Hz(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NaturalFreq_Hz.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%NaturalFreq_Hz,1), UBOUND(OutData%NaturalFreq_Hz,1) + OutData%NaturalFreq_Hz(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DampedFreq_Hz not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%DampedFreq_Hz)) DEALLOCATE(OutData%DampedFreq_Hz) + ALLOCATE(OutData%DampedFreq_Hz(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DampedFreq_Hz.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%DampedFreq_Hz,1), UBOUND(OutData%DampedFreq_Hz,1) + OutData%DampedFreq_Hz(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x_eig_magnitude not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%x_eig_magnitude)) DEALLOCATE(OutData%x_eig_magnitude) + ALLOCATE(OutData%x_eig_magnitude(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_eig_magnitude.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%x_eig_magnitude,3), UBOUND(OutData%x_eig_magnitude,3) + DO i2 = LBOUND(OutData%x_eig_magnitude,2), UBOUND(OutData%x_eig_magnitude,2) + DO i1 = LBOUND(OutData%x_eig_magnitude,1), UBOUND(OutData%x_eig_magnitude,1) + OutData%x_eig_magnitude(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x_eig_phase not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i3_l = IntKiBuf( Int_Xferred ) + i3_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%x_eig_phase)) DEALLOCATE(OutData%x_eig_phase) + ALLOCATE(OutData%x_eig_phase(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_eig_phase.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i3 = LBOUND(OutData%x_eig_phase,3), UBOUND(OutData%x_eig_phase,3) + DO i2 = LBOUND(OutData%x_eig_phase,2), UBOUND(OutData%x_eig_phase,2) + DO i1 = LBOUND(OutData%x_eig_phase,1), UBOUND(OutData%x_eig_phase,1) + OutData%x_eig_phase(i1,i2,i3) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END DO + END IF + END SUBROUTINE FAST_UnPackVTK_ModeShapeType SUBROUTINE FAST_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) TYPE(FAST_ParameterType), INTENT(IN) :: SrcParamData @@ -1417,6 +2117,7 @@ SUBROUTINE FAST_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%WrSttsTime = SrcParamData%WrSttsTime DstParamData%n_SttsTime = SrcParamData%n_SttsTime DstParamData%n_ChkptTime = SrcParamData%n_ChkptTime + DstParamData%n_DT_Out = SrcParamData%n_DT_Out DstParamData%n_VTKTime = SrcParamData%n_VTKTime DstParamData%TurbineType = SrcParamData%TurbineType DstParamData%WrBinOutFile = SrcParamData%WrBinOutFile @@ -1433,29 +2134,32 @@ SUBROUTINE FAST_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%TChanLen = SrcParamData%TChanLen DstParamData%OutFileRoot = SrcParamData%OutFileRoot DstParamData%FTitle = SrcParamData%FTitle -IF (ALLOCATED(SrcParamData%LinTimes)) THEN - i1_l = LBOUND(SrcParamData%LinTimes,1) - i1_u = UBOUND(SrcParamData%LinTimes,1) - IF (.NOT. ALLOCATED(DstParamData%LinTimes)) THEN - ALLOCATE(DstParamData%LinTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%LinTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%LinTimes = SrcParamData%LinTimes -ENDIF + DstParamData%VTK_OutFileRoot = SrcParamData%VTK_OutFileRoot + DstParamData%VTK_tWidth = SrcParamData%VTK_tWidth + DstParamData%VTK_fps = SrcParamData%VTK_fps + CALL FAST_Copyvtk_surfacetype( SrcParamData%VTK_surface, DstParamData%VTK_surface, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + DstParamData%TurbinePos = SrcParamData%TurbinePos + DstParamData%Tdesc = SrcParamData%Tdesc + DstParamData%CalcSteady = SrcParamData%CalcSteady + DstParamData%TrimCase = SrcParamData%TrimCase + DstParamData%TrimTol = SrcParamData%TrimTol + DstParamData%TrimGain = SrcParamData%TrimGain + DstParamData%Twr_Kdmp = SrcParamData%Twr_Kdmp + DstParamData%Bld_Kdmp = SrcParamData%Bld_Kdmp + DstParamData%NLinTimes = SrcParamData%NLinTimes + DstParamData%AzimDelta = SrcParamData%AzimDelta DstParamData%LinInputs = SrcParamData%LinInputs DstParamData%LinOutputs = SrcParamData%LinOutputs DstParamData%LinOutJac = SrcParamData%LinOutJac DstParamData%LinOutMod = SrcParamData%LinOutMod - CALL FAST_Copyvtk_surfacetype( SrcParamData%VTK_surface, DstParamData%VTK_surface, CtrlCode, ErrStat2, ErrMsg2 ) + CALL FAST_Copyvtk_modeshapetype( SrcParamData%VTK_modes, DstParamData%VTK_modes, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - DstParamData%TurbinePos = SrcParamData%TurbinePos DstParamData%Lin_NumMods = SrcParamData%Lin_NumMods DstParamData%Lin_ModOrder = SrcParamData%Lin_ModOrder - DstParamData%Tdesc = SrcParamData%Tdesc + DstParamData%LinInterpOrder = SrcParamData%LinInterpOrder END SUBROUTINE FAST_CopyParam SUBROUTINE FAST_DestroyParam( ParamData, ErrStat, ErrMsg ) @@ -1467,10 +2171,8 @@ SUBROUTINE FAST_DestroyParam( ParamData, ErrStat, ErrMsg ) ! ErrStat = ErrID_None ErrMsg = "" -IF (ALLOCATED(ParamData%LinTimes)) THEN - DEALLOCATE(ParamData%LinTimes) -ENDIF CALL FAST_Destroyvtk_surfacetype( ParamData%VTK_surface, ErrStat, ErrMsg ) + CALL FAST_Destroyvtk_modeshapetype( ParamData%VTK_modes, ErrStat, ErrMsg ) END SUBROUTINE FAST_DestroyParam SUBROUTINE FAST_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) @@ -1547,6 +2249,7 @@ SUBROUTINE FAST_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_BufSz = Int_BufSz + 1 ! WrSttsTime Int_BufSz = Int_BufSz + 1 ! n_SttsTime Int_BufSz = Int_BufSz + 1 ! n_ChkptTime + Int_BufSz = Int_BufSz + 1 ! n_DT_Out Int_BufSz = Int_BufSz + 1 ! n_VTKTime Int_BufSz = Int_BufSz + 1 ! TurbineType Int_BufSz = Int_BufSz + 1 ! WrBinOutFile @@ -1563,15 +2266,9 @@ SUBROUTINE FAST_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_BufSz = Int_BufSz + 1 ! TChanLen Int_BufSz = Int_BufSz + 1*LEN(InData%OutFileRoot) ! OutFileRoot Int_BufSz = Int_BufSz + 1*LEN(InData%FTitle) ! FTitle - Int_BufSz = Int_BufSz + 1 ! LinTimes allocated yes/no - IF ( ALLOCATED(InData%LinTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! LinTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%LinTimes) ! LinTimes - END IF - Int_BufSz = Int_BufSz + 1 ! LinInputs - Int_BufSz = Int_BufSz + 1 ! LinOutputs - Int_BufSz = Int_BufSz + 1 ! LinOutJac - Int_BufSz = Int_BufSz + 1 ! LinOutMod + Int_BufSz = Int_BufSz + 1*LEN(InData%VTK_OutFileRoot) ! VTK_OutFileRoot + Int_BufSz = Int_BufSz + 1 ! VTK_tWidth + Db_BufSz = Db_BufSz + 1 ! VTK_fps ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! VTK_surface: size of buffers for each call to pack subtype CALL FAST_Packvtk_surfacetype( Re_Buf, Db_Buf, Int_Buf, InData%VTK_surface, ErrStat2, ErrMsg2, .TRUE. ) ! VTK_surface @@ -1591,9 +2288,39 @@ SUBROUTINE FAST_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, DEALLOCATE(Int_Buf) END IF Re_BufSz = Re_BufSz + SIZE(InData%TurbinePos) ! TurbinePos + Int_BufSz = Int_BufSz + 1*LEN(InData%Tdesc) ! Tdesc + Int_BufSz = Int_BufSz + 1 ! CalcSteady + Int_BufSz = Int_BufSz + 1 ! TrimCase + Re_BufSz = Re_BufSz + 1 ! TrimTol + Re_BufSz = Re_BufSz + 1 ! TrimGain + Re_BufSz = Re_BufSz + 1 ! Twr_Kdmp + Re_BufSz = Re_BufSz + 1 ! Bld_Kdmp + Int_BufSz = Int_BufSz + 1 ! NLinTimes + Db_BufSz = Db_BufSz + 1 ! AzimDelta + Int_BufSz = Int_BufSz + 1 ! LinInputs + Int_BufSz = Int_BufSz + 1 ! LinOutputs + Int_BufSz = Int_BufSz + 1 ! LinOutJac + Int_BufSz = Int_BufSz + 1 ! LinOutMod + Int_BufSz = Int_BufSz + 3 ! VTK_modes: size of buffers for each call to pack subtype + CALL FAST_Packvtk_modeshapetype( Re_Buf, Db_Buf, Int_Buf, InData%VTK_modes, ErrStat2, ErrMsg2, .TRUE. ) ! VTK_modes + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! VTK_modes + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! VTK_modes + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! VTK_modes + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF Int_BufSz = Int_BufSz + 1 ! Lin_NumMods Int_BufSz = Int_BufSz + SIZE(InData%Lin_ModOrder) ! Lin_ModOrder - Int_BufSz = Int_BufSz + 1*LEN(InData%Tdesc) ! Tdesc + Int_BufSz = Int_BufSz + 1 ! LinInterpOrder IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -1621,167 +2348,164 @@ SUBROUTINE FAST_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%DT_module))-1 ) = PACK(InData%DT_module,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%DT_module) - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%n_substeps))-1 ) = PACK(InData%n_substeps,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%n_substeps) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%n_TMax_m1 - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%TMax - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%InterpOrder - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumCrctn - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%KMax - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%numIceLegs - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%nBeams - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%BD_OutputSibling , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%ModuleInitialized)-1 ) = TRANSFER(PACK( InData%ModuleInitialized ,.TRUE.), IntKiBuf(1), SIZE(InData%ModuleInitialized)) - Int_Xferred = Int_Xferred + SIZE(InData%ModuleInitialized) - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT_Ujac - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%UJacSclFact - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%SizeJac_Opt1))-1 ) = PACK(InData%SizeJac_Opt1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%SizeJac_Opt1) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%CompElast - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%CompInflow - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%CompAero - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%CompServo - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%CompHydro - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%CompSub - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%CompMooring - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%CompIce - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%UseDWM , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Linearize , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%EDFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%EDFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(InData%DT_module,1), UBOUND(InData%DT_module,1) + DbKiBuf(Db_Xferred) = InData%DT_module(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%n_substeps,1), UBOUND(InData%n_substeps,1) + IntKiBuf(Int_Xferred) = InData%n_substeps(i1) + Int_Xferred = Int_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%n_TMax_m1 + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%TMax + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%InterpOrder + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumCrctn + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%KMax + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%numIceLegs + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%nBeams + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%BD_OutputSibling, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%ModuleInitialized,1), UBOUND(InData%ModuleInitialized,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%ModuleInitialized(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + DbKiBuf(Db_Xferred) = InData%DT_Ujac + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%UJacSclFact + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%SizeJac_Opt1,1), UBOUND(InData%SizeJac_Opt1,1) + IntKiBuf(Int_Xferred) = InData%SizeJac_Opt1(i1) + Int_Xferred = Int_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%CompElast + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%CompInflow + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%CompAero + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%CompServo + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%CompHydro + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%CompSub + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%CompMooring + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%CompIce + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%UseDWM, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%Linearize, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%EDFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%EDFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I DO i1 = LBOUND(InData%BDBldFile,1), UBOUND(InData%BDBldFile,1) - DO I = 1, LEN(InData%BDBldFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%BDBldFile(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - DO I = 1, LEN(InData%InflowFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InflowFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%AeroFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%AeroFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%ServoFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%ServoFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%HydroFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%HydroFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%SubFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%SubFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%MooringFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%MooringFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%IceFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%IceFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%TStart - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT_Out - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%WrSttsTime , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%n_SttsTime - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%n_ChkptTime - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%n_VTKTime - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TurbineType - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%WrBinOutFile , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%WrTxtOutFile , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WrBinMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%SumPrint , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%WrVTK - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%VTK_Type - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%VTK_fields , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%Delim) - IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%OutFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%OutFmt_t) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt_t(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%FmtWidth - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TChanLen - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutFileRoot) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFileRoot(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%FTitle) - IntKiBuf(Int_Xferred) = ICHAR(InData%FTitle(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( .NOT. ALLOCATED(InData%LinTimes) ) THEN - IntKiBuf( Int_Xferred ) = 0 + DO I = 1, LEN(InData%BDBldFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%BDBldFile(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + DO I = 1, LEN(InData%InflowFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%InflowFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%AeroFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%AeroFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%ServoFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%ServoFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%HydroFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%HydroFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%SubFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%SubFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%MooringFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%MooringFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%IceFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%IceFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DbKiBuf(Db_Xferred) = InData%TStart + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT_Out + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%WrSttsTime, IntKiBuf(1)) Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 + IntKiBuf(Int_Xferred) = InData%n_SttsTime Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%LinTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinTimes,1) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%LinTimes)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%LinTimes))-1 ) = PACK(InData%LinTimes,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%LinTimes) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%LinInputs - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%LinOutputs - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%LinOutJac , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%LinOutMod , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%n_ChkptTime + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%n_DT_Out + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%n_VTKTime + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TurbineType + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%WrBinOutFile, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%WrTxtOutFile, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WrBinMod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%SumPrint, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%WrVTK + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%VTK_Type + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%VTK_fields, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%Delim) + IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%OutFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%OutFmt_t) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt_t(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%FmtWidth + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TChanLen + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%OutFileRoot) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutFileRoot(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%FTitle) + IntKiBuf(Int_Xferred) = ICHAR(InData%FTitle(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%VTK_OutFileRoot) + IntKiBuf(Int_Xferred) = ICHAR(InData%VTK_OutFileRoot(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%VTK_tWidth + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%VTK_fps + Db_Xferred = Db_Xferred + 1 CALL FAST_Packvtk_surfacetype( Re_Buf, Db_Buf, Int_Buf, InData%VTK_surface, ErrStat2, ErrMsg2, OnlySize ) ! VTK_surface CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1810,16 +2534,74 @@ SUBROUTINE FAST_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TurbinePos))-1 ) = PACK(InData%TurbinePos,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TurbinePos) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Lin_NumMods - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%Lin_ModOrder))-1 ) = PACK(InData%Lin_ModOrder,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%Lin_ModOrder) - DO I = 1, LEN(InData%Tdesc) - IntKiBuf(Int_Xferred) = ICHAR(InData%Tdesc(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO i1 = LBOUND(InData%TurbinePos,1), UBOUND(InData%TurbinePos,1) + ReKiBuf(Re_Xferred) = InData%TurbinePos(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO I = 1, LEN(InData%Tdesc) + IntKiBuf(Int_Xferred) = ICHAR(InData%Tdesc(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%CalcSteady, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TrimCase + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TrimTol + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TrimGain + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Twr_Kdmp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Bld_Kdmp + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NLinTimes + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%AzimDelta + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%LinInputs + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%LinOutputs + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%LinOutJac, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%LinOutMod, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + CALL FAST_Packvtk_modeshapetype( Re_Buf, Db_Buf, Int_Buf, InData%VTK_modes, ErrStat2, ErrMsg2, OnlySize ) ! VTK_modes + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IntKiBuf(Int_Xferred) = InData%Lin_NumMods + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%Lin_ModOrder,1), UBOUND(InData%Lin_ModOrder,1) + IntKiBuf(Int_Xferred) = InData%Lin_ModOrder(i1) + Int_Xferred = Int_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%LinInterpOrder + Int_Xferred = Int_Xferred + 1 END SUBROUTINE FAST_PackParam SUBROUTINE FAST_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1835,12 +2617,6 @@ SUBROUTINE FAST_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1855,222 +2631,174 @@ SUBROUTINE FAST_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 i1_l = LBOUND(OutData%DT_module,1) i1_u = UBOUND(OutData%DT_module,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%DT_module = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%DT_module))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%DT_module) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%DT_module,1), UBOUND(OutData%DT_module,1) + OutData%DT_module(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%n_substeps,1) i1_u = UBOUND(OutData%n_substeps,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%n_substeps = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%n_substeps))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%n_substeps) - DEALLOCATE(mask1) - OutData%n_TMax_m1 = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TMax = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%InterpOrder = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumCrctn = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%KMax = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%numIceLegs = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%nBeams = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%BD_OutputSibling = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%n_substeps,1), UBOUND(OutData%n_substeps,1) + OutData%n_substeps(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + OutData%n_TMax_m1 = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TMax = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%InterpOrder = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumCrctn = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%KMax = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%numIceLegs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%nBeams = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%BD_OutputSibling = TRANSFER(IntKiBuf(Int_Xferred), OutData%BD_OutputSibling) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%ModuleInitialized,1) i1_u = UBOUND(OutData%ModuleInitialized,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%ModuleInitialized = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%ModuleInitialized))-1 ), OutData%ModuleInitialized), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%ModuleInitialized) - DEALLOCATE(mask1) - OutData%DT_Ujac = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%UJacSclFact = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%ModuleInitialized,1), UBOUND(OutData%ModuleInitialized,1) + OutData%ModuleInitialized(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%ModuleInitialized(i1)) + Int_Xferred = Int_Xferred + 1 + END DO + OutData%DT_Ujac = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%UJacSclFact = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%SizeJac_Opt1,1) i1_u = UBOUND(OutData%SizeJac_Opt1,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%SizeJac_Opt1 = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%SizeJac_Opt1))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%SizeJac_Opt1) - DEALLOCATE(mask1) - OutData%CompElast = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%CompInflow = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%CompAero = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%CompServo = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%CompHydro = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%CompSub = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%CompMooring = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%CompIce = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%UseDWM = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%Linearize = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%EDFile) - OutData%EDFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO i1 = LBOUND(OutData%SizeJac_Opt1,1), UBOUND(OutData%SizeJac_Opt1,1) + OutData%SizeJac_Opt1(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + OutData%CompElast = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%CompInflow = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%CompAero = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%CompServo = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%CompHydro = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%CompSub = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%CompMooring = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%CompIce = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%UseDWM = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseDWM) + Int_Xferred = Int_Xferred + 1 + OutData%Linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%Linearize) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%EDFile) + OutData%EDFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I i1_l = LBOUND(OutData%BDBldFile,1) i1_u = UBOUND(OutData%BDBldFile,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. DO i1 = LBOUND(OutData%BDBldFile,1), UBOUND(OutData%BDBldFile,1) - DO I = 1, LEN(OutData%BDBldFile) - OutData%BDBldFile(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - DEALLOCATE(mask1) - DO I = 1, LEN(OutData%InflowFile) - OutData%InflowFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%AeroFile) - OutData%AeroFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%ServoFile) - OutData%ServoFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%HydroFile) - OutData%HydroFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%SubFile) - OutData%SubFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%MooringFile) - OutData%MooringFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%BDBldFile) + OutData%BDBldFile(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 END DO ! I - DO I = 1, LEN(OutData%IceFile) - OutData%IceFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%TStart = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%DT_Out = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%WrSttsTime = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%n_SttsTime = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%n_ChkptTime = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%n_VTKTime = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TurbineType = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%WrBinOutFile = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%WrTxtOutFile = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%WrBinMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%SumPrint = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%WrVTK = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%VTK_Type = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%VTK_fields = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%Delim) - OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%OutFmt) - OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%OutFmt_t) - OutData%OutFmt_t(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%FmtWidth = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TChanLen = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutFileRoot) - OutData%OutFileRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%FTitle) - OutData%FTitle(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinTimes not allocated + END DO + DO I = 1, LEN(OutData%InflowFile) + OutData%InflowFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%AeroFile) + OutData%AeroFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%ServoFile) + OutData%ServoFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%HydroFile) + OutData%HydroFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%SubFile) + OutData%SubFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%MooringFile) + OutData%MooringFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%IceFile) + OutData%IceFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%TStart = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%DT_Out = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%WrSttsTime = TRANSFER(IntKiBuf(Int_Xferred), OutData%WrSttsTime) Int_Xferred = Int_Xferred + 1 - ELSE + OutData%n_SttsTime = IntKiBuf(Int_Xferred) Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%LinTimes)) DEALLOCATE(OutData%LinTimes) - ALLOCATE(OutData%LinTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%LinTimes)>0) OutData%LinTimes = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%LinTimes))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%LinTimes) - DEALLOCATE(mask1) - END IF - OutData%LinInputs = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%LinOutputs = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%LinOutJac = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%LinOutMod = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%n_ChkptTime = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%n_DT_Out = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%n_VTKTime = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TurbineType = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%WrBinOutFile = TRANSFER(IntKiBuf(Int_Xferred), OutData%WrBinOutFile) + Int_Xferred = Int_Xferred + 1 + OutData%WrTxtOutFile = TRANSFER(IntKiBuf(Int_Xferred), OutData%WrTxtOutFile) + Int_Xferred = Int_Xferred + 1 + OutData%WrBinMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%SumPrint = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumPrint) + Int_Xferred = Int_Xferred + 1 + OutData%WrVTK = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%VTK_Type = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%VTK_fields = TRANSFER(IntKiBuf(Int_Xferred), OutData%VTK_fields) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%Delim) + OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%OutFmt) + OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%OutFmt_t) + OutData%OutFmt_t(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%FmtWidth = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TChanLen = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%OutFileRoot) + OutData%OutFileRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%FTitle) + OutData%FTitle(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%VTK_OutFileRoot) + OutData%VTK_OutFileRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%VTK_tWidth = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%VTK_fps = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -2113,37 +2841,93 @@ SUBROUTINE FAST_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) i1_l = LBOUND(OutData%TurbinePos,1) i1_u = UBOUND(OutData%TurbinePos,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%TurbinePos = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TurbinePos))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%TurbinePos) - DEALLOCATE(mask1) - OutData%Lin_NumMods = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%TurbinePos,1), UBOUND(OutData%TurbinePos,1) + OutData%TurbinePos(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + DO I = 1, LEN(OutData%Tdesc) + OutData%Tdesc(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%CalcSteady = TRANSFER(IntKiBuf(Int_Xferred), OutData%CalcSteady) + Int_Xferred = Int_Xferred + 1 + OutData%TrimCase = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TrimTol = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TrimGain = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Twr_Kdmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Bld_Kdmp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NLinTimes = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%AzimDelta = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%LinInputs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%LinOutputs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%LinOutJac = TRANSFER(IntKiBuf(Int_Xferred), OutData%LinOutJac) + Int_Xferred = Int_Xferred + 1 + OutData%LinOutMod = TRANSFER(IntKiBuf(Int_Xferred), OutData%LinOutMod) + Int_Xferred = Int_Xferred + 1 + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL FAST_Unpackvtk_modeshapetype( Re_Buf, Db_Buf, Int_Buf, OutData%VTK_modes, ErrStat2, ErrMsg2 ) ! VTK_modes + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + OutData%Lin_NumMods = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%Lin_ModOrder,1) i1_u = UBOUND(OutData%Lin_ModOrder,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%Lin_ModOrder = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%Lin_ModOrder))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%Lin_ModOrder) - DEALLOCATE(mask1) - DO I = 1, LEN(OutData%Tdesc) - OutData%Tdesc(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO i1 = LBOUND(OutData%Lin_ModOrder,1), UBOUND(OutData%Lin_ModOrder,1) + OutData%Lin_ModOrder(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + OutData%LinInterpOrder = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE FAST_UnPackParam - SUBROUTINE FAST_CopyLinType( SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_LinType), INTENT(IN) :: SrcLinTypeData - TYPE(FAST_LinType), INTENT(INOUT) :: DstLinTypeData + SUBROUTINE FAST_CopyLinStateSave( SrcLinStateSaveData, DstLinStateSaveData, CtrlCode, ErrStat, ErrMsg ) + TYPE(FAST_LinStateSave), INTENT(INOUT) :: SrcLinStateSaveData + TYPE(FAST_LinStateSave), INTENT(INOUT) :: DstLinStateSaveData INTEGER(IntKi), INTENT(IN ) :: CtrlCode INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg @@ -2153,1815 +2937,3014 @@ SUBROUTINE FAST_CopyLinType( SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyLinType' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyLinStateSave' ! ErrStat = ErrID_None ErrMsg = "" -IF (ALLOCATED(SrcLinTypeData%Names_u)) THEN - i1_l = LBOUND(SrcLinTypeData%Names_u,1) - i1_u = UBOUND(SrcLinTypeData%Names_u,1) - IF (.NOT. ALLOCATED(DstLinTypeData%Names_u)) THEN - ALLOCATE(DstLinTypeData%Names_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_u.', ErrStat, ErrMsg,RoutineName) +IF (ALLOCATED(SrcLinStateSaveData%x_IceD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%x_IceD,1) + i1_u = UBOUND(SrcLinStateSaveData%x_IceD,1) + i2_l = LBOUND(SrcLinStateSaveData%x_IceD,2) + i2_u = UBOUND(SrcLinStateSaveData%x_IceD,2) + IF (.NOT. ALLOCATED(DstLinStateSaveData%x_IceD)) THEN + ALLOCATE(DstLinStateSaveData%x_IceD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_IceD.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLinTypeData%Names_u = SrcLinTypeData%Names_u + DO i2 = LBOUND(SrcLinStateSaveData%x_IceD,2), UBOUND(SrcLinStateSaveData%x_IceD,2) + DO i1 = LBOUND(SrcLinStateSaveData%x_IceD,1), UBOUND(SrcLinStateSaveData%x_IceD,1) + CALL IceD_CopyContState( SrcLinStateSaveData%x_IceD(i1,i2), DstLinStateSaveData%x_IceD(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + ENDDO ENDIF -IF (ALLOCATED(SrcLinTypeData%Names_y)) THEN - i1_l = LBOUND(SrcLinTypeData%Names_y,1) - i1_u = UBOUND(SrcLinTypeData%Names_y,1) - IF (.NOT. ALLOCATED(DstLinTypeData%Names_y)) THEN - ALLOCATE(DstLinTypeData%Names_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_y.', ErrStat, ErrMsg,RoutineName) +IF (ALLOCATED(SrcLinStateSaveData%xd_IceD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%xd_IceD,1) + i1_u = UBOUND(SrcLinStateSaveData%xd_IceD,1) + i2_l = LBOUND(SrcLinStateSaveData%xd_IceD,2) + i2_u = UBOUND(SrcLinStateSaveData%xd_IceD,2) + IF (.NOT. ALLOCATED(DstLinStateSaveData%xd_IceD)) THEN + ALLOCATE(DstLinStateSaveData%xd_IceD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_IceD.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLinTypeData%Names_y = SrcLinTypeData%Names_y + DO i2 = LBOUND(SrcLinStateSaveData%xd_IceD,2), UBOUND(SrcLinStateSaveData%xd_IceD,2) + DO i1 = LBOUND(SrcLinStateSaveData%xd_IceD,1), UBOUND(SrcLinStateSaveData%xd_IceD,1) + CALL IceD_CopyDiscState( SrcLinStateSaveData%xd_IceD(i1,i2), DstLinStateSaveData%xd_IceD(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + ENDDO ENDIF -IF (ALLOCATED(SrcLinTypeData%Names_x)) THEN - i1_l = LBOUND(SrcLinTypeData%Names_x,1) - i1_u = UBOUND(SrcLinTypeData%Names_x,1) - IF (.NOT. ALLOCATED(DstLinTypeData%Names_x)) THEN - ALLOCATE(DstLinTypeData%Names_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_x.', ErrStat, ErrMsg,RoutineName) +IF (ALLOCATED(SrcLinStateSaveData%z_IceD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%z_IceD,1) + i1_u = UBOUND(SrcLinStateSaveData%z_IceD,1) + i2_l = LBOUND(SrcLinStateSaveData%z_IceD,2) + i2_u = UBOUND(SrcLinStateSaveData%z_IceD,2) + IF (.NOT. ALLOCATED(DstLinStateSaveData%z_IceD)) THEN + ALLOCATE(DstLinStateSaveData%z_IceD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_IceD.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLinTypeData%Names_x = SrcLinTypeData%Names_x + DO i2 = LBOUND(SrcLinStateSaveData%z_IceD,2), UBOUND(SrcLinStateSaveData%z_IceD,2) + DO i1 = LBOUND(SrcLinStateSaveData%z_IceD,1), UBOUND(SrcLinStateSaveData%z_IceD,1) + CALL IceD_CopyConstrState( SrcLinStateSaveData%z_IceD(i1,i2), DstLinStateSaveData%z_IceD(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + ENDDO ENDIF -IF (ALLOCATED(SrcLinTypeData%Names_xd)) THEN - i1_l = LBOUND(SrcLinTypeData%Names_xd,1) - i1_u = UBOUND(SrcLinTypeData%Names_xd,1) - IF (.NOT. ALLOCATED(DstLinTypeData%Names_xd)) THEN - ALLOCATE(DstLinTypeData%Names_xd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_xd.', ErrStat, ErrMsg,RoutineName) +IF (ALLOCATED(SrcLinStateSaveData%OtherSt_IceD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%OtherSt_IceD,1) + i1_u = UBOUND(SrcLinStateSaveData%OtherSt_IceD,1) + i2_l = LBOUND(SrcLinStateSaveData%OtherSt_IceD,2) + i2_u = UBOUND(SrcLinStateSaveData%OtherSt_IceD,2) + IF (.NOT. ALLOCATED(DstLinStateSaveData%OtherSt_IceD)) THEN + ALLOCATE(DstLinStateSaveData%OtherSt_IceD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_IceD.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLinTypeData%Names_xd = SrcLinTypeData%Names_xd + DO i2 = LBOUND(SrcLinStateSaveData%OtherSt_IceD,2), UBOUND(SrcLinStateSaveData%OtherSt_IceD,2) + DO i1 = LBOUND(SrcLinStateSaveData%OtherSt_IceD,1), UBOUND(SrcLinStateSaveData%OtherSt_IceD,1) + CALL IceD_CopyOtherState( SrcLinStateSaveData%OtherSt_IceD(i1,i2), DstLinStateSaveData%OtherSt_IceD(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + ENDDO ENDIF -IF (ALLOCATED(SrcLinTypeData%Names_z)) THEN - i1_l = LBOUND(SrcLinTypeData%Names_z,1) - i1_u = UBOUND(SrcLinTypeData%Names_z,1) - IF (.NOT. ALLOCATED(DstLinTypeData%Names_z)) THEN - ALLOCATE(DstLinTypeData%Names_z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_z.', ErrStat, ErrMsg,RoutineName) +IF (ALLOCATED(SrcLinStateSaveData%u_IceD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%u_IceD,1) + i1_u = UBOUND(SrcLinStateSaveData%u_IceD,1) + i2_l = LBOUND(SrcLinStateSaveData%u_IceD,2) + i2_u = UBOUND(SrcLinStateSaveData%u_IceD,2) + IF (.NOT. ALLOCATED(DstLinStateSaveData%u_IceD)) THEN + ALLOCATE(DstLinStateSaveData%u_IceD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_IceD.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLinTypeData%Names_z = SrcLinTypeData%Names_z + DO i2 = LBOUND(SrcLinStateSaveData%u_IceD,2), UBOUND(SrcLinStateSaveData%u_IceD,2) + DO i1 = LBOUND(SrcLinStateSaveData%u_IceD,1), UBOUND(SrcLinStateSaveData%u_IceD,1) + CALL IceD_CopyInput( SrcLinStateSaveData%u_IceD(i1,i2), DstLinStateSaveData%u_IceD(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + ENDDO ENDIF -IF (ALLOCATED(SrcLinTypeData%op_u)) THEN - i1_l = LBOUND(SrcLinTypeData%op_u,1) - i1_u = UBOUND(SrcLinTypeData%op_u,1) - IF (.NOT. ALLOCATED(DstLinTypeData%op_u)) THEN - ALLOCATE(DstLinTypeData%op_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_u.', ErrStat, ErrMsg,RoutineName) +IF (ALLOCATED(SrcLinStateSaveData%x_BD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%x_BD,1) + i1_u = UBOUND(SrcLinStateSaveData%x_BD,1) + i2_l = LBOUND(SrcLinStateSaveData%x_BD,2) + i2_u = UBOUND(SrcLinStateSaveData%x_BD,2) + IF (.NOT. ALLOCATED(DstLinStateSaveData%x_BD)) THEN + ALLOCATE(DstLinStateSaveData%x_BD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_BD.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLinTypeData%op_u = SrcLinTypeData%op_u + DO i2 = LBOUND(SrcLinStateSaveData%x_BD,2), UBOUND(SrcLinStateSaveData%x_BD,2) + DO i1 = LBOUND(SrcLinStateSaveData%x_BD,1), UBOUND(SrcLinStateSaveData%x_BD,1) + CALL BD_CopyContState( SrcLinStateSaveData%x_BD(i1,i2), DstLinStateSaveData%x_BD(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + ENDDO ENDIF -IF (ALLOCATED(SrcLinTypeData%op_y)) THEN - i1_l = LBOUND(SrcLinTypeData%op_y,1) - i1_u = UBOUND(SrcLinTypeData%op_y,1) - IF (.NOT. ALLOCATED(DstLinTypeData%op_y)) THEN - ALLOCATE(DstLinTypeData%op_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_y.', ErrStat, ErrMsg,RoutineName) +IF (ALLOCATED(SrcLinStateSaveData%xd_BD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%xd_BD,1) + i1_u = UBOUND(SrcLinStateSaveData%xd_BD,1) + i2_l = LBOUND(SrcLinStateSaveData%xd_BD,2) + i2_u = UBOUND(SrcLinStateSaveData%xd_BD,2) + IF (.NOT. ALLOCATED(DstLinStateSaveData%xd_BD)) THEN + ALLOCATE(DstLinStateSaveData%xd_BD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_BD.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLinTypeData%op_y = SrcLinTypeData%op_y + DO i2 = LBOUND(SrcLinStateSaveData%xd_BD,2), UBOUND(SrcLinStateSaveData%xd_BD,2) + DO i1 = LBOUND(SrcLinStateSaveData%xd_BD,1), UBOUND(SrcLinStateSaveData%xd_BD,1) + CALL BD_CopyDiscState( SrcLinStateSaveData%xd_BD(i1,i2), DstLinStateSaveData%xd_BD(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + ENDDO ENDIF -IF (ALLOCATED(SrcLinTypeData%op_x)) THEN - i1_l = LBOUND(SrcLinTypeData%op_x,1) - i1_u = UBOUND(SrcLinTypeData%op_x,1) - IF (.NOT. ALLOCATED(DstLinTypeData%op_x)) THEN - ALLOCATE(DstLinTypeData%op_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_x.', ErrStat, ErrMsg,RoutineName) +IF (ALLOCATED(SrcLinStateSaveData%z_BD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%z_BD,1) + i1_u = UBOUND(SrcLinStateSaveData%z_BD,1) + i2_l = LBOUND(SrcLinStateSaveData%z_BD,2) + i2_u = UBOUND(SrcLinStateSaveData%z_BD,2) + IF (.NOT. ALLOCATED(DstLinStateSaveData%z_BD)) THEN + ALLOCATE(DstLinStateSaveData%z_BD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_BD.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLinTypeData%op_x = SrcLinTypeData%op_x + DO i2 = LBOUND(SrcLinStateSaveData%z_BD,2), UBOUND(SrcLinStateSaveData%z_BD,2) + DO i1 = LBOUND(SrcLinStateSaveData%z_BD,1), UBOUND(SrcLinStateSaveData%z_BD,1) + CALL BD_CopyConstrState( SrcLinStateSaveData%z_BD(i1,i2), DstLinStateSaveData%z_BD(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + ENDDO ENDIF -IF (ALLOCATED(SrcLinTypeData%op_dx)) THEN - i1_l = LBOUND(SrcLinTypeData%op_dx,1) - i1_u = UBOUND(SrcLinTypeData%op_dx,1) - IF (.NOT. ALLOCATED(DstLinTypeData%op_dx)) THEN - ALLOCATE(DstLinTypeData%op_dx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_dx.', ErrStat, ErrMsg,RoutineName) +IF (ALLOCATED(SrcLinStateSaveData%OtherSt_BD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%OtherSt_BD,1) + i1_u = UBOUND(SrcLinStateSaveData%OtherSt_BD,1) + i2_l = LBOUND(SrcLinStateSaveData%OtherSt_BD,2) + i2_u = UBOUND(SrcLinStateSaveData%OtherSt_BD,2) + IF (.NOT. ALLOCATED(DstLinStateSaveData%OtherSt_BD)) THEN + ALLOCATE(DstLinStateSaveData%OtherSt_BD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_BD.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLinTypeData%op_dx = SrcLinTypeData%op_dx + DO i2 = LBOUND(SrcLinStateSaveData%OtherSt_BD,2), UBOUND(SrcLinStateSaveData%OtherSt_BD,2) + DO i1 = LBOUND(SrcLinStateSaveData%OtherSt_BD,1), UBOUND(SrcLinStateSaveData%OtherSt_BD,1) + CALL BD_CopyOtherState( SrcLinStateSaveData%OtherSt_BD(i1,i2), DstLinStateSaveData%OtherSt_BD(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + ENDDO ENDIF -IF (ALLOCATED(SrcLinTypeData%op_xd)) THEN - i1_l = LBOUND(SrcLinTypeData%op_xd,1) - i1_u = UBOUND(SrcLinTypeData%op_xd,1) - IF (.NOT. ALLOCATED(DstLinTypeData%op_xd)) THEN - ALLOCATE(DstLinTypeData%op_xd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_xd.', ErrStat, ErrMsg,RoutineName) +IF (ALLOCATED(SrcLinStateSaveData%u_BD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%u_BD,1) + i1_u = UBOUND(SrcLinStateSaveData%u_BD,1) + i2_l = LBOUND(SrcLinStateSaveData%u_BD,2) + i2_u = UBOUND(SrcLinStateSaveData%u_BD,2) + IF (.NOT. ALLOCATED(DstLinStateSaveData%u_BD)) THEN + ALLOCATE(DstLinStateSaveData%u_BD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_BD.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLinTypeData%op_xd = SrcLinTypeData%op_xd + DO i2 = LBOUND(SrcLinStateSaveData%u_BD,2), UBOUND(SrcLinStateSaveData%u_BD,2) + DO i1 = LBOUND(SrcLinStateSaveData%u_BD,1), UBOUND(SrcLinStateSaveData%u_BD,1) + CALL BD_CopyInput( SrcLinStateSaveData%u_BD(i1,i2), DstLinStateSaveData%u_BD(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + ENDDO ENDIF -IF (ALLOCATED(SrcLinTypeData%op_z)) THEN - i1_l = LBOUND(SrcLinTypeData%op_z,1) - i1_u = UBOUND(SrcLinTypeData%op_z,1) - IF (.NOT. ALLOCATED(DstLinTypeData%op_z)) THEN - ALLOCATE(DstLinTypeData%op_z(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcLinStateSaveData%x_ED)) THEN + i1_l = LBOUND(SrcLinStateSaveData%x_ED,1) + i1_u = UBOUND(SrcLinStateSaveData%x_ED,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%x_ED)) THEN + ALLOCATE(DstLinStateSaveData%x_ED(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_z.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_ED.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLinTypeData%op_z = SrcLinTypeData%op_z + DO i1 = LBOUND(SrcLinStateSaveData%x_ED,1), UBOUND(SrcLinStateSaveData%x_ED,1) + CALL ED_CopyContState( SrcLinStateSaveData%x_ED(i1), DstLinStateSaveData%x_ED(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(SrcLinTypeData%Use_u)) THEN - i1_l = LBOUND(SrcLinTypeData%Use_u,1) - i1_u = UBOUND(SrcLinTypeData%Use_u,1) - IF (.NOT. ALLOCATED(DstLinTypeData%Use_u)) THEN - ALLOCATE(DstLinTypeData%Use_u(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcLinStateSaveData%xd_ED)) THEN + i1_l = LBOUND(SrcLinStateSaveData%xd_ED,1) + i1_u = UBOUND(SrcLinStateSaveData%xd_ED,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%xd_ED)) THEN + ALLOCATE(DstLinStateSaveData%xd_ED(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Use_u.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_ED.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLinTypeData%Use_u = SrcLinTypeData%Use_u + DO i1 = LBOUND(SrcLinStateSaveData%xd_ED,1), UBOUND(SrcLinStateSaveData%xd_ED,1) + CALL ED_CopyDiscState( SrcLinStateSaveData%xd_ED(i1), DstLinStateSaveData%xd_ED(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(SrcLinTypeData%Use_y)) THEN - i1_l = LBOUND(SrcLinTypeData%Use_y,1) - i1_u = UBOUND(SrcLinTypeData%Use_y,1) - IF (.NOT. ALLOCATED(DstLinTypeData%Use_y)) THEN - ALLOCATE(DstLinTypeData%Use_y(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcLinStateSaveData%z_ED)) THEN + i1_l = LBOUND(SrcLinStateSaveData%z_ED,1) + i1_u = UBOUND(SrcLinStateSaveData%z_ED,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%z_ED)) THEN + ALLOCATE(DstLinStateSaveData%z_ED(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Use_y.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_ED.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLinTypeData%Use_y = SrcLinTypeData%Use_y + DO i1 = LBOUND(SrcLinStateSaveData%z_ED,1), UBOUND(SrcLinStateSaveData%z_ED,1) + CALL ED_CopyConstrState( SrcLinStateSaveData%z_ED(i1), DstLinStateSaveData%z_ED(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(SrcLinTypeData%A)) THEN - i1_l = LBOUND(SrcLinTypeData%A,1) - i1_u = UBOUND(SrcLinTypeData%A,1) - i2_l = LBOUND(SrcLinTypeData%A,2) - i2_u = UBOUND(SrcLinTypeData%A,2) - IF (.NOT. ALLOCATED(DstLinTypeData%A)) THEN - ALLOCATE(DstLinTypeData%A(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) +IF (ALLOCATED(SrcLinStateSaveData%OtherSt_ED)) THEN + i1_l = LBOUND(SrcLinStateSaveData%OtherSt_ED,1) + i1_u = UBOUND(SrcLinStateSaveData%OtherSt_ED,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%OtherSt_ED)) THEN + ALLOCATE(DstLinStateSaveData%OtherSt_ED(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%A.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_ED.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLinTypeData%A = SrcLinTypeData%A + DO i1 = LBOUND(SrcLinStateSaveData%OtherSt_ED,1), UBOUND(SrcLinStateSaveData%OtherSt_ED,1) + CALL ED_CopyOtherState( SrcLinStateSaveData%OtherSt_ED(i1), DstLinStateSaveData%OtherSt_ED(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(SrcLinTypeData%B)) THEN - i1_l = LBOUND(SrcLinTypeData%B,1) - i1_u = UBOUND(SrcLinTypeData%B,1) - i2_l = LBOUND(SrcLinTypeData%B,2) - i2_u = UBOUND(SrcLinTypeData%B,2) - IF (.NOT. ALLOCATED(DstLinTypeData%B)) THEN - ALLOCATE(DstLinTypeData%B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) +IF (ALLOCATED(SrcLinStateSaveData%u_ED)) THEN + i1_l = LBOUND(SrcLinStateSaveData%u_ED,1) + i1_u = UBOUND(SrcLinStateSaveData%u_ED,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%u_ED)) THEN + ALLOCATE(DstLinStateSaveData%u_ED(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%B.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_ED.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLinTypeData%B = SrcLinTypeData%B + DO i1 = LBOUND(SrcLinStateSaveData%u_ED,1), UBOUND(SrcLinStateSaveData%u_ED,1) + CALL ED_CopyInput( SrcLinStateSaveData%u_ED(i1), DstLinStateSaveData%u_ED(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(SrcLinTypeData%C)) THEN - i1_l = LBOUND(SrcLinTypeData%C,1) - i1_u = UBOUND(SrcLinTypeData%C,1) - i2_l = LBOUND(SrcLinTypeData%C,2) - i2_u = UBOUND(SrcLinTypeData%C,2) - IF (.NOT. ALLOCATED(DstLinTypeData%C)) THEN - ALLOCATE(DstLinTypeData%C(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) +IF (ALLOCATED(SrcLinStateSaveData%x_SrvD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%x_SrvD,1) + i1_u = UBOUND(SrcLinStateSaveData%x_SrvD,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%x_SrvD)) THEN + ALLOCATE(DstLinStateSaveData%x_SrvD(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%C.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_SrvD.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLinTypeData%C = SrcLinTypeData%C + DO i1 = LBOUND(SrcLinStateSaveData%x_SrvD,1), UBOUND(SrcLinStateSaveData%x_SrvD,1) + CALL SrvD_CopyContState( SrcLinStateSaveData%x_SrvD(i1), DstLinStateSaveData%x_SrvD(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(SrcLinTypeData%D)) THEN - i1_l = LBOUND(SrcLinTypeData%D,1) - i1_u = UBOUND(SrcLinTypeData%D,1) - i2_l = LBOUND(SrcLinTypeData%D,2) - i2_u = UBOUND(SrcLinTypeData%D,2) - IF (.NOT. ALLOCATED(DstLinTypeData%D)) THEN - ALLOCATE(DstLinTypeData%D(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) +IF (ALLOCATED(SrcLinStateSaveData%xd_SrvD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%xd_SrvD,1) + i1_u = UBOUND(SrcLinStateSaveData%xd_SrvD,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%xd_SrvD)) THEN + ALLOCATE(DstLinStateSaveData%xd_SrvD(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%D.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_SrvD.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLinTypeData%D = SrcLinTypeData%D + DO i1 = LBOUND(SrcLinStateSaveData%xd_SrvD,1), UBOUND(SrcLinStateSaveData%xd_SrvD,1) + CALL SrvD_CopyDiscState( SrcLinStateSaveData%xd_SrvD(i1), DstLinStateSaveData%xd_SrvD(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(SrcLinTypeData%StateRotation)) THEN - i1_l = LBOUND(SrcLinTypeData%StateRotation,1) - i1_u = UBOUND(SrcLinTypeData%StateRotation,1) - i2_l = LBOUND(SrcLinTypeData%StateRotation,2) - i2_u = UBOUND(SrcLinTypeData%StateRotation,2) - IF (.NOT. ALLOCATED(DstLinTypeData%StateRotation)) THEN - ALLOCATE(DstLinTypeData%StateRotation(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) +IF (ALLOCATED(SrcLinStateSaveData%z_SrvD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%z_SrvD,1) + i1_u = UBOUND(SrcLinStateSaveData%z_SrvD,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%z_SrvD)) THEN + ALLOCATE(DstLinStateSaveData%z_SrvD(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%StateRotation.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_SrvD.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLinTypeData%StateRotation = SrcLinTypeData%StateRotation + DO i1 = LBOUND(SrcLinStateSaveData%z_SrvD,1), UBOUND(SrcLinStateSaveData%z_SrvD,1) + CALL SrvD_CopyConstrState( SrcLinStateSaveData%z_SrvD(i1), DstLinStateSaveData%z_SrvD(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(SrcLinTypeData%StateRel_x)) THEN - i1_l = LBOUND(SrcLinTypeData%StateRel_x,1) - i1_u = UBOUND(SrcLinTypeData%StateRel_x,1) - i2_l = LBOUND(SrcLinTypeData%StateRel_x,2) - i2_u = UBOUND(SrcLinTypeData%StateRel_x,2) - IF (.NOT. ALLOCATED(DstLinTypeData%StateRel_x)) THEN - ALLOCATE(DstLinTypeData%StateRel_x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) +IF (ALLOCATED(SrcLinStateSaveData%OtherSt_SrvD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%OtherSt_SrvD,1) + i1_u = UBOUND(SrcLinStateSaveData%OtherSt_SrvD,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%OtherSt_SrvD)) THEN + ALLOCATE(DstLinStateSaveData%OtherSt_SrvD(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%StateRel_x.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_SrvD.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLinTypeData%StateRel_x = SrcLinTypeData%StateRel_x + DO i1 = LBOUND(SrcLinStateSaveData%OtherSt_SrvD,1), UBOUND(SrcLinStateSaveData%OtherSt_SrvD,1) + CALL SrvD_CopyOtherState( SrcLinStateSaveData%OtherSt_SrvD(i1), DstLinStateSaveData%OtherSt_SrvD(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(SrcLinTypeData%StateRel_xdot)) THEN - i1_l = LBOUND(SrcLinTypeData%StateRel_xdot,1) - i1_u = UBOUND(SrcLinTypeData%StateRel_xdot,1) - i2_l = LBOUND(SrcLinTypeData%StateRel_xdot,2) - i2_u = UBOUND(SrcLinTypeData%StateRel_xdot,2) - IF (.NOT. ALLOCATED(DstLinTypeData%StateRel_xdot)) THEN - ALLOCATE(DstLinTypeData%StateRel_xdot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) +IF (ALLOCATED(SrcLinStateSaveData%u_SrvD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%u_SrvD,1) + i1_u = UBOUND(SrcLinStateSaveData%u_SrvD,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%u_SrvD)) THEN + ALLOCATE(DstLinStateSaveData%u_SrvD(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%StateRel_xdot.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_SrvD.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLinTypeData%StateRel_xdot = SrcLinTypeData%StateRel_xdot + DO i1 = LBOUND(SrcLinStateSaveData%u_SrvD,1), UBOUND(SrcLinStateSaveData%u_SrvD,1) + CALL SrvD_CopyInput( SrcLinStateSaveData%u_SrvD(i1), DstLinStateSaveData%u_SrvD(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(SrcLinTypeData%IsLoad_u)) THEN - i1_l = LBOUND(SrcLinTypeData%IsLoad_u,1) - i1_u = UBOUND(SrcLinTypeData%IsLoad_u,1) - IF (.NOT. ALLOCATED(DstLinTypeData%IsLoad_u)) THEN - ALLOCATE(DstLinTypeData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcLinStateSaveData%x_AD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%x_AD,1) + i1_u = UBOUND(SrcLinStateSaveData%x_AD,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%x_AD)) THEN + ALLOCATE(DstLinStateSaveData%x_AD(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_AD.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLinTypeData%IsLoad_u = SrcLinTypeData%IsLoad_u + DO i1 = LBOUND(SrcLinStateSaveData%x_AD,1), UBOUND(SrcLinStateSaveData%x_AD,1) + CALL AD_CopyContState( SrcLinStateSaveData%x_AD(i1), DstLinStateSaveData%x_AD(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(SrcLinTypeData%RotFrame_u)) THEN - i1_l = LBOUND(SrcLinTypeData%RotFrame_u,1) - i1_u = UBOUND(SrcLinTypeData%RotFrame_u,1) - IF (.NOT. ALLOCATED(DstLinTypeData%RotFrame_u)) THEN - ALLOCATE(DstLinTypeData%RotFrame_u(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcLinStateSaveData%xd_AD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%xd_AD,1) + i1_u = UBOUND(SrcLinStateSaveData%xd_AD,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%xd_AD)) THEN + ALLOCATE(DstLinStateSaveData%xd_AD(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_AD.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLinTypeData%RotFrame_u = SrcLinTypeData%RotFrame_u + DO i1 = LBOUND(SrcLinStateSaveData%xd_AD,1), UBOUND(SrcLinStateSaveData%xd_AD,1) + CALL AD_CopyDiscState( SrcLinStateSaveData%xd_AD(i1), DstLinStateSaveData%xd_AD(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(SrcLinTypeData%RotFrame_y)) THEN - i1_l = LBOUND(SrcLinTypeData%RotFrame_y,1) - i1_u = UBOUND(SrcLinTypeData%RotFrame_y,1) - IF (.NOT. ALLOCATED(DstLinTypeData%RotFrame_y)) THEN - ALLOCATE(DstLinTypeData%RotFrame_y(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcLinStateSaveData%z_AD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%z_AD,1) + i1_u = UBOUND(SrcLinStateSaveData%z_AD,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%z_AD)) THEN + ALLOCATE(DstLinStateSaveData%z_AD(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_AD.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLinTypeData%RotFrame_y = SrcLinTypeData%RotFrame_y + DO i1 = LBOUND(SrcLinStateSaveData%z_AD,1), UBOUND(SrcLinStateSaveData%z_AD,1) + CALL AD_CopyConstrState( SrcLinStateSaveData%z_AD(i1), DstLinStateSaveData%z_AD(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(SrcLinTypeData%RotFrame_x)) THEN - i1_l = LBOUND(SrcLinTypeData%RotFrame_x,1) - i1_u = UBOUND(SrcLinTypeData%RotFrame_x,1) - IF (.NOT. ALLOCATED(DstLinTypeData%RotFrame_x)) THEN - ALLOCATE(DstLinTypeData%RotFrame_x(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcLinStateSaveData%OtherSt_AD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%OtherSt_AD,1) + i1_u = UBOUND(SrcLinStateSaveData%OtherSt_AD,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%OtherSt_AD)) THEN + ALLOCATE(DstLinStateSaveData%OtherSt_AD(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%RotFrame_x.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_AD.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLinTypeData%RotFrame_x = SrcLinTypeData%RotFrame_x + DO i1 = LBOUND(SrcLinStateSaveData%OtherSt_AD,1), UBOUND(SrcLinStateSaveData%OtherSt_AD,1) + CALL AD_CopyOtherState( SrcLinStateSaveData%OtherSt_AD(i1), DstLinStateSaveData%OtherSt_AD(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(SrcLinTypeData%RotFrame_z)) THEN - i1_l = LBOUND(SrcLinTypeData%RotFrame_z,1) - i1_u = UBOUND(SrcLinTypeData%RotFrame_z,1) - IF (.NOT. ALLOCATED(DstLinTypeData%RotFrame_z)) THEN - ALLOCATE(DstLinTypeData%RotFrame_z(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcLinStateSaveData%u_AD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%u_AD,1) + i1_u = UBOUND(SrcLinStateSaveData%u_AD,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%u_AD)) THEN + ALLOCATE(DstLinStateSaveData%u_AD(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%RotFrame_z.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_AD.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLinTypeData%RotFrame_z = SrcLinTypeData%RotFrame_z + DO i1 = LBOUND(SrcLinStateSaveData%u_AD,1), UBOUND(SrcLinStateSaveData%u_AD,1) + CALL AD_CopyInput( SrcLinStateSaveData%u_AD(i1), DstLinStateSaveData%u_AD(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(SrcLinTypeData%DerivOrder_x)) THEN - i1_l = LBOUND(SrcLinTypeData%DerivOrder_x,1) - i1_u = UBOUND(SrcLinTypeData%DerivOrder_x,1) - IF (.NOT. ALLOCATED(DstLinTypeData%DerivOrder_x)) THEN - ALLOCATE(DstLinTypeData%DerivOrder_x(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcLinStateSaveData%x_IfW)) THEN + i1_l = LBOUND(SrcLinStateSaveData%x_IfW,1) + i1_u = UBOUND(SrcLinStateSaveData%x_IfW,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%x_IfW)) THEN + ALLOCATE(DstLinStateSaveData%x_IfW(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_IfW.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstLinTypeData%DerivOrder_x = SrcLinTypeData%DerivOrder_x -ENDIF - DstLinTypeData%SizeLin = SrcLinTypeData%SizeLin - DstLinTypeData%LinStartIndx = SrcLinTypeData%LinStartIndx - DstLinTypeData%NumOutputs = SrcLinTypeData%NumOutputs - END SUBROUTINE FAST_CopyLinType - - SUBROUTINE FAST_DestroyLinType( LinTypeData, ErrStat, ErrMsg ) - TYPE(FAST_LinType), INTENT(INOUT) :: LinTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyLinType' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(LinTypeData%Names_u)) THEN - DEALLOCATE(LinTypeData%Names_u) + DO i1 = LBOUND(SrcLinStateSaveData%x_IfW,1), UBOUND(SrcLinStateSaveData%x_IfW,1) + CALL InflowWind_CopyContState( SrcLinStateSaveData%x_IfW(i1), DstLinStateSaveData%x_IfW(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(LinTypeData%Names_y)) THEN - DEALLOCATE(LinTypeData%Names_y) +IF (ALLOCATED(SrcLinStateSaveData%xd_IfW)) THEN + i1_l = LBOUND(SrcLinStateSaveData%xd_IfW,1) + i1_u = UBOUND(SrcLinStateSaveData%xd_IfW,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%xd_IfW)) THEN + ALLOCATE(DstLinStateSaveData%xd_IfW(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_IfW.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcLinStateSaveData%xd_IfW,1), UBOUND(SrcLinStateSaveData%xd_IfW,1) + CALL InflowWind_CopyDiscState( SrcLinStateSaveData%xd_IfW(i1), DstLinStateSaveData%xd_IfW(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(LinTypeData%Names_x)) THEN - DEALLOCATE(LinTypeData%Names_x) +IF (ALLOCATED(SrcLinStateSaveData%z_IfW)) THEN + i1_l = LBOUND(SrcLinStateSaveData%z_IfW,1) + i1_u = UBOUND(SrcLinStateSaveData%z_IfW,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%z_IfW)) THEN + ALLOCATE(DstLinStateSaveData%z_IfW(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_IfW.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcLinStateSaveData%z_IfW,1), UBOUND(SrcLinStateSaveData%z_IfW,1) + CALL InflowWind_CopyConstrState( SrcLinStateSaveData%z_IfW(i1), DstLinStateSaveData%z_IfW(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(LinTypeData%Names_xd)) THEN - DEALLOCATE(LinTypeData%Names_xd) +IF (ALLOCATED(SrcLinStateSaveData%OtherSt_IfW)) THEN + i1_l = LBOUND(SrcLinStateSaveData%OtherSt_IfW,1) + i1_u = UBOUND(SrcLinStateSaveData%OtherSt_IfW,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%OtherSt_IfW)) THEN + ALLOCATE(DstLinStateSaveData%OtherSt_IfW(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_IfW.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcLinStateSaveData%OtherSt_IfW,1), UBOUND(SrcLinStateSaveData%OtherSt_IfW,1) + CALL InflowWind_CopyOtherState( SrcLinStateSaveData%OtherSt_IfW(i1), DstLinStateSaveData%OtherSt_IfW(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(LinTypeData%Names_z)) THEN - DEALLOCATE(LinTypeData%Names_z) +IF (ALLOCATED(SrcLinStateSaveData%u_IfW)) THEN + i1_l = LBOUND(SrcLinStateSaveData%u_IfW,1) + i1_u = UBOUND(SrcLinStateSaveData%u_IfW,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%u_IfW)) THEN + ALLOCATE(DstLinStateSaveData%u_IfW(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_IfW.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcLinStateSaveData%u_IfW,1), UBOUND(SrcLinStateSaveData%u_IfW,1) + CALL InflowWind_CopyInput( SrcLinStateSaveData%u_IfW(i1), DstLinStateSaveData%u_IfW(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(LinTypeData%op_u)) THEN - DEALLOCATE(LinTypeData%op_u) +IF (ALLOCATED(SrcLinStateSaveData%x_SD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%x_SD,1) + i1_u = UBOUND(SrcLinStateSaveData%x_SD,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%x_SD)) THEN + ALLOCATE(DstLinStateSaveData%x_SD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_SD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcLinStateSaveData%x_SD,1), UBOUND(SrcLinStateSaveData%x_SD,1) + CALL SD_CopyContState( SrcLinStateSaveData%x_SD(i1), DstLinStateSaveData%x_SD(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(LinTypeData%op_y)) THEN - DEALLOCATE(LinTypeData%op_y) +IF (ALLOCATED(SrcLinStateSaveData%xd_SD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%xd_SD,1) + i1_u = UBOUND(SrcLinStateSaveData%xd_SD,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%xd_SD)) THEN + ALLOCATE(DstLinStateSaveData%xd_SD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_SD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcLinStateSaveData%xd_SD,1), UBOUND(SrcLinStateSaveData%xd_SD,1) + CALL SD_CopyDiscState( SrcLinStateSaveData%xd_SD(i1), DstLinStateSaveData%xd_SD(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(LinTypeData%op_x)) THEN - DEALLOCATE(LinTypeData%op_x) +IF (ALLOCATED(SrcLinStateSaveData%z_SD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%z_SD,1) + i1_u = UBOUND(SrcLinStateSaveData%z_SD,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%z_SD)) THEN + ALLOCATE(DstLinStateSaveData%z_SD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_SD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcLinStateSaveData%z_SD,1), UBOUND(SrcLinStateSaveData%z_SD,1) + CALL SD_CopyConstrState( SrcLinStateSaveData%z_SD(i1), DstLinStateSaveData%z_SD(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(LinTypeData%op_dx)) THEN - DEALLOCATE(LinTypeData%op_dx) +IF (ALLOCATED(SrcLinStateSaveData%OtherSt_SD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%OtherSt_SD,1) + i1_u = UBOUND(SrcLinStateSaveData%OtherSt_SD,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%OtherSt_SD)) THEN + ALLOCATE(DstLinStateSaveData%OtherSt_SD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_SD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcLinStateSaveData%OtherSt_SD,1), UBOUND(SrcLinStateSaveData%OtherSt_SD,1) + CALL SD_CopyOtherState( SrcLinStateSaveData%OtherSt_SD(i1), DstLinStateSaveData%OtherSt_SD(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(LinTypeData%op_xd)) THEN - DEALLOCATE(LinTypeData%op_xd) +IF (ALLOCATED(SrcLinStateSaveData%u_SD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%u_SD,1) + i1_u = UBOUND(SrcLinStateSaveData%u_SD,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%u_SD)) THEN + ALLOCATE(DstLinStateSaveData%u_SD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_SD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcLinStateSaveData%u_SD,1), UBOUND(SrcLinStateSaveData%u_SD,1) + CALL SD_CopyInput( SrcLinStateSaveData%u_SD(i1), DstLinStateSaveData%u_SD(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(LinTypeData%op_z)) THEN - DEALLOCATE(LinTypeData%op_z) +IF (ALLOCATED(SrcLinStateSaveData%x_ExtPtfm)) THEN + i1_l = LBOUND(SrcLinStateSaveData%x_ExtPtfm,1) + i1_u = UBOUND(SrcLinStateSaveData%x_ExtPtfm,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%x_ExtPtfm)) THEN + ALLOCATE(DstLinStateSaveData%x_ExtPtfm(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_ExtPtfm.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcLinStateSaveData%x_ExtPtfm,1), UBOUND(SrcLinStateSaveData%x_ExtPtfm,1) + CALL ExtPtfm_CopyContState( SrcLinStateSaveData%x_ExtPtfm(i1), DstLinStateSaveData%x_ExtPtfm(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(LinTypeData%Use_u)) THEN - DEALLOCATE(LinTypeData%Use_u) +IF (ALLOCATED(SrcLinStateSaveData%xd_ExtPtfm)) THEN + i1_l = LBOUND(SrcLinStateSaveData%xd_ExtPtfm,1) + i1_u = UBOUND(SrcLinStateSaveData%xd_ExtPtfm,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%xd_ExtPtfm)) THEN + ALLOCATE(DstLinStateSaveData%xd_ExtPtfm(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_ExtPtfm.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcLinStateSaveData%xd_ExtPtfm,1), UBOUND(SrcLinStateSaveData%xd_ExtPtfm,1) + CALL ExtPtfm_CopyDiscState( SrcLinStateSaveData%xd_ExtPtfm(i1), DstLinStateSaveData%xd_ExtPtfm(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(LinTypeData%Use_y)) THEN - DEALLOCATE(LinTypeData%Use_y) +IF (ALLOCATED(SrcLinStateSaveData%z_ExtPtfm)) THEN + i1_l = LBOUND(SrcLinStateSaveData%z_ExtPtfm,1) + i1_u = UBOUND(SrcLinStateSaveData%z_ExtPtfm,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%z_ExtPtfm)) THEN + ALLOCATE(DstLinStateSaveData%z_ExtPtfm(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_ExtPtfm.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcLinStateSaveData%z_ExtPtfm,1), UBOUND(SrcLinStateSaveData%z_ExtPtfm,1) + CALL ExtPtfm_CopyConstrState( SrcLinStateSaveData%z_ExtPtfm(i1), DstLinStateSaveData%z_ExtPtfm(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(LinTypeData%A)) THEN - DEALLOCATE(LinTypeData%A) +IF (ALLOCATED(SrcLinStateSaveData%OtherSt_ExtPtfm)) THEN + i1_l = LBOUND(SrcLinStateSaveData%OtherSt_ExtPtfm,1) + i1_u = UBOUND(SrcLinStateSaveData%OtherSt_ExtPtfm,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%OtherSt_ExtPtfm)) THEN + ALLOCATE(DstLinStateSaveData%OtherSt_ExtPtfm(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_ExtPtfm.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcLinStateSaveData%OtherSt_ExtPtfm,1), UBOUND(SrcLinStateSaveData%OtherSt_ExtPtfm,1) + CALL ExtPtfm_CopyOtherState( SrcLinStateSaveData%OtherSt_ExtPtfm(i1), DstLinStateSaveData%OtherSt_ExtPtfm(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(LinTypeData%B)) THEN - DEALLOCATE(LinTypeData%B) +IF (ALLOCATED(SrcLinStateSaveData%u_ExtPtfm)) THEN + i1_l = LBOUND(SrcLinStateSaveData%u_ExtPtfm,1) + i1_u = UBOUND(SrcLinStateSaveData%u_ExtPtfm,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%u_ExtPtfm)) THEN + ALLOCATE(DstLinStateSaveData%u_ExtPtfm(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_ExtPtfm.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcLinStateSaveData%u_ExtPtfm,1), UBOUND(SrcLinStateSaveData%u_ExtPtfm,1) + CALL ExtPtfm_CopyInput( SrcLinStateSaveData%u_ExtPtfm(i1), DstLinStateSaveData%u_ExtPtfm(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(LinTypeData%C)) THEN - DEALLOCATE(LinTypeData%C) +IF (ALLOCATED(SrcLinStateSaveData%x_HD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%x_HD,1) + i1_u = UBOUND(SrcLinStateSaveData%x_HD,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%x_HD)) THEN + ALLOCATE(DstLinStateSaveData%x_HD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_HD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcLinStateSaveData%x_HD,1), UBOUND(SrcLinStateSaveData%x_HD,1) + CALL HydroDyn_CopyContState( SrcLinStateSaveData%x_HD(i1), DstLinStateSaveData%x_HD(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(LinTypeData%D)) THEN - DEALLOCATE(LinTypeData%D) +IF (ALLOCATED(SrcLinStateSaveData%xd_HD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%xd_HD,1) + i1_u = UBOUND(SrcLinStateSaveData%xd_HD,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%xd_HD)) THEN + ALLOCATE(DstLinStateSaveData%xd_HD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_HD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcLinStateSaveData%xd_HD,1), UBOUND(SrcLinStateSaveData%xd_HD,1) + CALL HydroDyn_CopyDiscState( SrcLinStateSaveData%xd_HD(i1), DstLinStateSaveData%xd_HD(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(LinTypeData%StateRotation)) THEN - DEALLOCATE(LinTypeData%StateRotation) +IF (ALLOCATED(SrcLinStateSaveData%z_HD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%z_HD,1) + i1_u = UBOUND(SrcLinStateSaveData%z_HD,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%z_HD)) THEN + ALLOCATE(DstLinStateSaveData%z_HD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_HD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcLinStateSaveData%z_HD,1), UBOUND(SrcLinStateSaveData%z_HD,1) + CALL HydroDyn_CopyConstrState( SrcLinStateSaveData%z_HD(i1), DstLinStateSaveData%z_HD(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(LinTypeData%StateRel_x)) THEN - DEALLOCATE(LinTypeData%StateRel_x) +IF (ALLOCATED(SrcLinStateSaveData%OtherSt_HD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%OtherSt_HD,1) + i1_u = UBOUND(SrcLinStateSaveData%OtherSt_HD,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%OtherSt_HD)) THEN + ALLOCATE(DstLinStateSaveData%OtherSt_HD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_HD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcLinStateSaveData%OtherSt_HD,1), UBOUND(SrcLinStateSaveData%OtherSt_HD,1) + CALL HydroDyn_CopyOtherState( SrcLinStateSaveData%OtherSt_HD(i1), DstLinStateSaveData%OtherSt_HD(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(LinTypeData%StateRel_xdot)) THEN - DEALLOCATE(LinTypeData%StateRel_xdot) +IF (ALLOCATED(SrcLinStateSaveData%u_HD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%u_HD,1) + i1_u = UBOUND(SrcLinStateSaveData%u_HD,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%u_HD)) THEN + ALLOCATE(DstLinStateSaveData%u_HD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_HD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcLinStateSaveData%u_HD,1), UBOUND(SrcLinStateSaveData%u_HD,1) + CALL HydroDyn_CopyInput( SrcLinStateSaveData%u_HD(i1), DstLinStateSaveData%u_HD(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(LinTypeData%IsLoad_u)) THEN - DEALLOCATE(LinTypeData%IsLoad_u) +IF (ALLOCATED(SrcLinStateSaveData%x_IceF)) THEN + i1_l = LBOUND(SrcLinStateSaveData%x_IceF,1) + i1_u = UBOUND(SrcLinStateSaveData%x_IceF,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%x_IceF)) THEN + ALLOCATE(DstLinStateSaveData%x_IceF(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_IceF.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcLinStateSaveData%x_IceF,1), UBOUND(SrcLinStateSaveData%x_IceF,1) + CALL IceFloe_CopyContState( SrcLinStateSaveData%x_IceF(i1), DstLinStateSaveData%x_IceF(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(LinTypeData%RotFrame_u)) THEN - DEALLOCATE(LinTypeData%RotFrame_u) +IF (ALLOCATED(SrcLinStateSaveData%xd_IceF)) THEN + i1_l = LBOUND(SrcLinStateSaveData%xd_IceF,1) + i1_u = UBOUND(SrcLinStateSaveData%xd_IceF,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%xd_IceF)) THEN + ALLOCATE(DstLinStateSaveData%xd_IceF(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_IceF.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcLinStateSaveData%xd_IceF,1), UBOUND(SrcLinStateSaveData%xd_IceF,1) + CALL IceFloe_CopyDiscState( SrcLinStateSaveData%xd_IceF(i1), DstLinStateSaveData%xd_IceF(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(LinTypeData%RotFrame_y)) THEN - DEALLOCATE(LinTypeData%RotFrame_y) +IF (ALLOCATED(SrcLinStateSaveData%z_IceF)) THEN + i1_l = LBOUND(SrcLinStateSaveData%z_IceF,1) + i1_u = UBOUND(SrcLinStateSaveData%z_IceF,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%z_IceF)) THEN + ALLOCATE(DstLinStateSaveData%z_IceF(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_IceF.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcLinStateSaveData%z_IceF,1), UBOUND(SrcLinStateSaveData%z_IceF,1) + CALL IceFloe_CopyConstrState( SrcLinStateSaveData%z_IceF(i1), DstLinStateSaveData%z_IceF(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(LinTypeData%RotFrame_x)) THEN - DEALLOCATE(LinTypeData%RotFrame_x) +IF (ALLOCATED(SrcLinStateSaveData%OtherSt_IceF)) THEN + i1_l = LBOUND(SrcLinStateSaveData%OtherSt_IceF,1) + i1_u = UBOUND(SrcLinStateSaveData%OtherSt_IceF,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%OtherSt_IceF)) THEN + ALLOCATE(DstLinStateSaveData%OtherSt_IceF(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_IceF.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcLinStateSaveData%OtherSt_IceF,1), UBOUND(SrcLinStateSaveData%OtherSt_IceF,1) + CALL IceFloe_CopyOtherState( SrcLinStateSaveData%OtherSt_IceF(i1), DstLinStateSaveData%OtherSt_IceF(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(LinTypeData%RotFrame_z)) THEN - DEALLOCATE(LinTypeData%RotFrame_z) +IF (ALLOCATED(SrcLinStateSaveData%u_IceF)) THEN + i1_l = LBOUND(SrcLinStateSaveData%u_IceF,1) + i1_u = UBOUND(SrcLinStateSaveData%u_IceF,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%u_IceF)) THEN + ALLOCATE(DstLinStateSaveData%u_IceF(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_IceF.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcLinStateSaveData%u_IceF,1), UBOUND(SrcLinStateSaveData%u_IceF,1) + CALL IceFloe_CopyInput( SrcLinStateSaveData%u_IceF(i1), DstLinStateSaveData%u_IceF(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF -IF (ALLOCATED(LinTypeData%DerivOrder_x)) THEN - DEALLOCATE(LinTypeData%DerivOrder_x) +IF (ALLOCATED(SrcLinStateSaveData%x_MAP)) THEN + i1_l = LBOUND(SrcLinStateSaveData%x_MAP,1) + i1_u = UBOUND(SrcLinStateSaveData%x_MAP,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%x_MAP)) THEN + ALLOCATE(DstLinStateSaveData%x_MAP(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_MAP.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcLinStateSaveData%x_MAP,1), UBOUND(SrcLinStateSaveData%x_MAP,1) + CALL MAP_CopyContState( SrcLinStateSaveData%x_MAP(i1), DstLinStateSaveData%x_MAP(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF - END SUBROUTINE FAST_DestroyLinType - - SUBROUTINE FAST_PackLinType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FAST_LinType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackLinType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! Names_u allocated yes/no - IF ( ALLOCATED(InData%Names_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Names_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Names_u)*LEN(InData%Names_u) ! Names_u +IF (ALLOCATED(SrcLinStateSaveData%xd_MAP)) THEN + i1_l = LBOUND(SrcLinStateSaveData%xd_MAP,1) + i1_u = UBOUND(SrcLinStateSaveData%xd_MAP,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%xd_MAP)) THEN + ALLOCATE(DstLinStateSaveData%xd_MAP(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_MAP.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Int_BufSz = Int_BufSz + 1 ! Names_y allocated yes/no - IF ( ALLOCATED(InData%Names_y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Names_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Names_y)*LEN(InData%Names_y) ! Names_y + DO i1 = LBOUND(SrcLinStateSaveData%xd_MAP,1), UBOUND(SrcLinStateSaveData%xd_MAP,1) + CALL MAP_CopyDiscState( SrcLinStateSaveData%xd_MAP(i1), DstLinStateSaveData%xd_MAP(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcLinStateSaveData%z_MAP)) THEN + i1_l = LBOUND(SrcLinStateSaveData%z_MAP,1) + i1_u = UBOUND(SrcLinStateSaveData%z_MAP,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%z_MAP)) THEN + ALLOCATE(DstLinStateSaveData%z_MAP(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_MAP.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Int_BufSz = Int_BufSz + 1 ! Names_x allocated yes/no - IF ( ALLOCATED(InData%Names_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Names_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Names_x)*LEN(InData%Names_x) ! Names_x + DO i1 = LBOUND(SrcLinStateSaveData%z_MAP,1), UBOUND(SrcLinStateSaveData%z_MAP,1) + CALL MAP_CopyConstrState( SrcLinStateSaveData%z_MAP(i1), DstLinStateSaveData%z_MAP(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcLinStateSaveData%u_MAP)) THEN + i1_l = LBOUND(SrcLinStateSaveData%u_MAP,1) + i1_u = UBOUND(SrcLinStateSaveData%u_MAP,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%u_MAP)) THEN + ALLOCATE(DstLinStateSaveData%u_MAP(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_MAP.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Int_BufSz = Int_BufSz + 1 ! Names_xd allocated yes/no - IF ( ALLOCATED(InData%Names_xd) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Names_xd upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Names_xd)*LEN(InData%Names_xd) ! Names_xd + DO i1 = LBOUND(SrcLinStateSaveData%u_MAP,1), UBOUND(SrcLinStateSaveData%u_MAP,1) + CALL MAP_CopyInput( SrcLinStateSaveData%u_MAP(i1), DstLinStateSaveData%u_MAP(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcLinStateSaveData%x_FEAM)) THEN + i1_l = LBOUND(SrcLinStateSaveData%x_FEAM,1) + i1_u = UBOUND(SrcLinStateSaveData%x_FEAM,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%x_FEAM)) THEN + ALLOCATE(DstLinStateSaveData%x_FEAM(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_FEAM.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Int_BufSz = Int_BufSz + 1 ! Names_z allocated yes/no - IF ( ALLOCATED(InData%Names_z) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Names_z upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Names_z)*LEN(InData%Names_z) ! Names_z + DO i1 = LBOUND(SrcLinStateSaveData%x_FEAM,1), UBOUND(SrcLinStateSaveData%x_FEAM,1) + CALL FEAM_CopyContState( SrcLinStateSaveData%x_FEAM(i1), DstLinStateSaveData%x_FEAM(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcLinStateSaveData%xd_FEAM)) THEN + i1_l = LBOUND(SrcLinStateSaveData%xd_FEAM,1) + i1_u = UBOUND(SrcLinStateSaveData%xd_FEAM,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%xd_FEAM)) THEN + ALLOCATE(DstLinStateSaveData%xd_FEAM(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_FEAM.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Int_BufSz = Int_BufSz + 1 ! op_u allocated yes/no - IF ( ALLOCATED(InData%op_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! op_u upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%op_u) ! op_u + DO i1 = LBOUND(SrcLinStateSaveData%xd_FEAM,1), UBOUND(SrcLinStateSaveData%xd_FEAM,1) + CALL FEAM_CopyDiscState( SrcLinStateSaveData%xd_FEAM(i1), DstLinStateSaveData%xd_FEAM(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcLinStateSaveData%z_FEAM)) THEN + i1_l = LBOUND(SrcLinStateSaveData%z_FEAM,1) + i1_u = UBOUND(SrcLinStateSaveData%z_FEAM,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%z_FEAM)) THEN + ALLOCATE(DstLinStateSaveData%z_FEAM(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_FEAM.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Int_BufSz = Int_BufSz + 1 ! op_y allocated yes/no - IF ( ALLOCATED(InData%op_y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! op_y upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%op_y) ! op_y + DO i1 = LBOUND(SrcLinStateSaveData%z_FEAM,1), UBOUND(SrcLinStateSaveData%z_FEAM,1) + CALL FEAM_CopyConstrState( SrcLinStateSaveData%z_FEAM(i1), DstLinStateSaveData%z_FEAM(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcLinStateSaveData%OtherSt_FEAM)) THEN + i1_l = LBOUND(SrcLinStateSaveData%OtherSt_FEAM,1) + i1_u = UBOUND(SrcLinStateSaveData%OtherSt_FEAM,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%OtherSt_FEAM)) THEN + ALLOCATE(DstLinStateSaveData%OtherSt_FEAM(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_FEAM.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Int_BufSz = Int_BufSz + 1 ! op_x allocated yes/no - IF ( ALLOCATED(InData%op_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! op_x upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%op_x) ! op_x + DO i1 = LBOUND(SrcLinStateSaveData%OtherSt_FEAM,1), UBOUND(SrcLinStateSaveData%OtherSt_FEAM,1) + CALL FEAM_CopyOtherState( SrcLinStateSaveData%OtherSt_FEAM(i1), DstLinStateSaveData%OtherSt_FEAM(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcLinStateSaveData%u_FEAM)) THEN + i1_l = LBOUND(SrcLinStateSaveData%u_FEAM,1) + i1_u = UBOUND(SrcLinStateSaveData%u_FEAM,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%u_FEAM)) THEN + ALLOCATE(DstLinStateSaveData%u_FEAM(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_FEAM.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Int_BufSz = Int_BufSz + 1 ! op_dx allocated yes/no - IF ( ALLOCATED(InData%op_dx) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! op_dx upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%op_dx) ! op_dx + DO i1 = LBOUND(SrcLinStateSaveData%u_FEAM,1), UBOUND(SrcLinStateSaveData%u_FEAM,1) + CALL FEAM_CopyInput( SrcLinStateSaveData%u_FEAM(i1), DstLinStateSaveData%u_FEAM(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcLinStateSaveData%x_MD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%x_MD,1) + i1_u = UBOUND(SrcLinStateSaveData%x_MD,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%x_MD)) THEN + ALLOCATE(DstLinStateSaveData%x_MD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%x_MD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Int_BufSz = Int_BufSz + 1 ! op_xd allocated yes/no - IF ( ALLOCATED(InData%op_xd) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! op_xd upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%op_xd) ! op_xd + DO i1 = LBOUND(SrcLinStateSaveData%x_MD,1), UBOUND(SrcLinStateSaveData%x_MD,1) + CALL MD_CopyContState( SrcLinStateSaveData%x_MD(i1), DstLinStateSaveData%x_MD(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcLinStateSaveData%xd_MD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%xd_MD,1) + i1_u = UBOUND(SrcLinStateSaveData%xd_MD,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%xd_MD)) THEN + ALLOCATE(DstLinStateSaveData%xd_MD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%xd_MD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Int_BufSz = Int_BufSz + 1 ! op_z allocated yes/no - IF ( ALLOCATED(InData%op_z) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! op_z upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%op_z) ! op_z + DO i1 = LBOUND(SrcLinStateSaveData%xd_MD,1), UBOUND(SrcLinStateSaveData%xd_MD,1) + CALL MD_CopyDiscState( SrcLinStateSaveData%xd_MD(i1), DstLinStateSaveData%xd_MD(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcLinStateSaveData%z_MD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%z_MD,1) + i1_u = UBOUND(SrcLinStateSaveData%z_MD,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%z_MD)) THEN + ALLOCATE(DstLinStateSaveData%z_MD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%z_MD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Int_BufSz = Int_BufSz + 1 ! Use_u allocated yes/no - IF ( ALLOCATED(InData%Use_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Use_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Use_u) ! Use_u + DO i1 = LBOUND(SrcLinStateSaveData%z_MD,1), UBOUND(SrcLinStateSaveData%z_MD,1) + CALL MD_CopyConstrState( SrcLinStateSaveData%z_MD(i1), DstLinStateSaveData%z_MD(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcLinStateSaveData%OtherSt_MD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%OtherSt_MD,1) + i1_u = UBOUND(SrcLinStateSaveData%OtherSt_MD,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%OtherSt_MD)) THEN + ALLOCATE(DstLinStateSaveData%OtherSt_MD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%OtherSt_MD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Int_BufSz = Int_BufSz + 1 ! Use_y allocated yes/no - IF ( ALLOCATED(InData%Use_y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Use_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Use_y) ! Use_y + DO i1 = LBOUND(SrcLinStateSaveData%OtherSt_MD,1), UBOUND(SrcLinStateSaveData%OtherSt_MD,1) + CALL MD_CopyOtherState( SrcLinStateSaveData%OtherSt_MD(i1), DstLinStateSaveData%OtherSt_MD(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcLinStateSaveData%u_MD)) THEN + i1_l = LBOUND(SrcLinStateSaveData%u_MD,1) + i1_u = UBOUND(SrcLinStateSaveData%u_MD,1) + IF (.NOT. ALLOCATED(DstLinStateSaveData%u_MD)) THEN + ALLOCATE(DstLinStateSaveData%u_MD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinStateSaveData%u_MD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Int_BufSz = Int_BufSz + 1 ! A allocated yes/no - IF ( ALLOCATED(InData%A) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! A upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%A) ! A - END IF - Int_BufSz = Int_BufSz + 1 ! B allocated yes/no - IF ( ALLOCATED(InData%B) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! B upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%B) ! B - END IF - Int_BufSz = Int_BufSz + 1 ! C allocated yes/no - IF ( ALLOCATED(InData%C) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! C upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%C) ! C - END IF - Int_BufSz = Int_BufSz + 1 ! D allocated yes/no - IF ( ALLOCATED(InData%D) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! D upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%D) ! D - END IF - Int_BufSz = Int_BufSz + 1 ! StateRotation allocated yes/no - IF ( ALLOCATED(InData%StateRotation) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! StateRotation upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%StateRotation) ! StateRotation - END IF - Int_BufSz = Int_BufSz + 1 ! StateRel_x allocated yes/no - IF ( ALLOCATED(InData%StateRel_x) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! StateRel_x upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%StateRel_x) ! StateRel_x - END IF - Int_BufSz = Int_BufSz + 1 ! StateRel_xdot allocated yes/no - IF ( ALLOCATED(InData%StateRel_xdot) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! StateRel_xdot upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%StateRel_xdot) ! StateRel_xdot - END IF - Int_BufSz = Int_BufSz + 1 ! IsLoad_u allocated yes/no - IF ( ALLOCATED(InData%IsLoad_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IsLoad_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%IsLoad_u) ! IsLoad_u - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_u allocated yes/no - IF ( ALLOCATED(InData%RotFrame_u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_u upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_u) ! RotFrame_u - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_y allocated yes/no - IF ( ALLOCATED(InData%RotFrame_y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_y upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_y) ! RotFrame_y - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_x allocated yes/no - IF ( ALLOCATED(InData%RotFrame_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_x) ! RotFrame_x - END IF - Int_BufSz = Int_BufSz + 1 ! RotFrame_z allocated yes/no - IF ( ALLOCATED(InData%RotFrame_z) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! RotFrame_z upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_z) ! RotFrame_z - END IF - Int_BufSz = Int_BufSz + 1 ! DerivOrder_x allocated yes/no - IF ( ALLOCATED(InData%DerivOrder_x) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! DerivOrder_x upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%DerivOrder_x) ! DerivOrder_x - END IF - Int_BufSz = Int_BufSz + SIZE(InData%SizeLin) ! SizeLin - Int_BufSz = Int_BufSz + SIZE(InData%LinStartIndx) ! LinStartIndx - Int_BufSz = Int_BufSz + 1 ! NumOutputs - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + DO i1 = LBOUND(SrcLinStateSaveData%u_MD,1), UBOUND(SrcLinStateSaveData%u_MD,1) + CALL MD_CopyInput( SrcLinStateSaveData%u_MD(i1), DstLinStateSaveData%u_MD(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF + END SUBROUTINE FAST_CopyLinStateSave - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 + SUBROUTINE FAST_DestroyLinStateSave( LinStateSaveData, ErrStat, ErrMsg ) + TYPE(FAST_LinStateSave), INTENT(INOUT) :: LinStateSaveData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyLinStateSave' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(LinStateSaveData%x_IceD)) THEN +DO i2 = LBOUND(LinStateSaveData%x_IceD,2), UBOUND(LinStateSaveData%x_IceD,2) +DO i1 = LBOUND(LinStateSaveData%x_IceD,1), UBOUND(LinStateSaveData%x_IceD,1) + CALL IceD_DestroyContState( LinStateSaveData%x_IceD(i1,i2), ErrStat, ErrMsg ) +ENDDO +ENDDO + DEALLOCATE(LinStateSaveData%x_IceD) +ENDIF +IF (ALLOCATED(LinStateSaveData%xd_IceD)) THEN +DO i2 = LBOUND(LinStateSaveData%xd_IceD,2), UBOUND(LinStateSaveData%xd_IceD,2) +DO i1 = LBOUND(LinStateSaveData%xd_IceD,1), UBOUND(LinStateSaveData%xd_IceD,1) + CALL IceD_DestroyDiscState( LinStateSaveData%xd_IceD(i1,i2), ErrStat, ErrMsg ) +ENDDO +ENDDO + DEALLOCATE(LinStateSaveData%xd_IceD) +ENDIF +IF (ALLOCATED(LinStateSaveData%z_IceD)) THEN +DO i2 = LBOUND(LinStateSaveData%z_IceD,2), UBOUND(LinStateSaveData%z_IceD,2) +DO i1 = LBOUND(LinStateSaveData%z_IceD,1), UBOUND(LinStateSaveData%z_IceD,1) + CALL IceD_DestroyConstrState( LinStateSaveData%z_IceD(i1,i2), ErrStat, ErrMsg ) +ENDDO +ENDDO + DEALLOCATE(LinStateSaveData%z_IceD) +ENDIF +IF (ALLOCATED(LinStateSaveData%OtherSt_IceD)) THEN +DO i2 = LBOUND(LinStateSaveData%OtherSt_IceD,2), UBOUND(LinStateSaveData%OtherSt_IceD,2) +DO i1 = LBOUND(LinStateSaveData%OtherSt_IceD,1), UBOUND(LinStateSaveData%OtherSt_IceD,1) + CALL IceD_DestroyOtherState( LinStateSaveData%OtherSt_IceD(i1,i2), ErrStat, ErrMsg ) +ENDDO +ENDDO + DEALLOCATE(LinStateSaveData%OtherSt_IceD) +ENDIF +IF (ALLOCATED(LinStateSaveData%u_IceD)) THEN +DO i2 = LBOUND(LinStateSaveData%u_IceD,2), UBOUND(LinStateSaveData%u_IceD,2) +DO i1 = LBOUND(LinStateSaveData%u_IceD,1), UBOUND(LinStateSaveData%u_IceD,1) + CALL IceD_DestroyInput( LinStateSaveData%u_IceD(i1,i2), ErrStat, ErrMsg ) +ENDDO +ENDDO + DEALLOCATE(LinStateSaveData%u_IceD) +ENDIF +IF (ALLOCATED(LinStateSaveData%x_BD)) THEN +DO i2 = LBOUND(LinStateSaveData%x_BD,2), UBOUND(LinStateSaveData%x_BD,2) +DO i1 = LBOUND(LinStateSaveData%x_BD,1), UBOUND(LinStateSaveData%x_BD,1) + CALL BD_DestroyContState( LinStateSaveData%x_BD(i1,i2), ErrStat, ErrMsg ) +ENDDO +ENDDO + DEALLOCATE(LinStateSaveData%x_BD) +ENDIF +IF (ALLOCATED(LinStateSaveData%xd_BD)) THEN +DO i2 = LBOUND(LinStateSaveData%xd_BD,2), UBOUND(LinStateSaveData%xd_BD,2) +DO i1 = LBOUND(LinStateSaveData%xd_BD,1), UBOUND(LinStateSaveData%xd_BD,1) + CALL BD_DestroyDiscState( LinStateSaveData%xd_BD(i1,i2), ErrStat, ErrMsg ) +ENDDO +ENDDO + DEALLOCATE(LinStateSaveData%xd_BD) +ENDIF +IF (ALLOCATED(LinStateSaveData%z_BD)) THEN +DO i2 = LBOUND(LinStateSaveData%z_BD,2), UBOUND(LinStateSaveData%z_BD,2) +DO i1 = LBOUND(LinStateSaveData%z_BD,1), UBOUND(LinStateSaveData%z_BD,1) + CALL BD_DestroyConstrState( LinStateSaveData%z_BD(i1,i2), ErrStat, ErrMsg ) +ENDDO +ENDDO + DEALLOCATE(LinStateSaveData%z_BD) +ENDIF +IF (ALLOCATED(LinStateSaveData%OtherSt_BD)) THEN +DO i2 = LBOUND(LinStateSaveData%OtherSt_BD,2), UBOUND(LinStateSaveData%OtherSt_BD,2) +DO i1 = LBOUND(LinStateSaveData%OtherSt_BD,1), UBOUND(LinStateSaveData%OtherSt_BD,1) + CALL BD_DestroyOtherState( LinStateSaveData%OtherSt_BD(i1,i2), ErrStat, ErrMsg ) +ENDDO +ENDDO + DEALLOCATE(LinStateSaveData%OtherSt_BD) +ENDIF +IF (ALLOCATED(LinStateSaveData%u_BD)) THEN +DO i2 = LBOUND(LinStateSaveData%u_BD,2), UBOUND(LinStateSaveData%u_BD,2) +DO i1 = LBOUND(LinStateSaveData%u_BD,1), UBOUND(LinStateSaveData%u_BD,1) + CALL BD_DestroyInput( LinStateSaveData%u_BD(i1,i2), ErrStat, ErrMsg ) +ENDDO +ENDDO + DEALLOCATE(LinStateSaveData%u_BD) +ENDIF +IF (ALLOCATED(LinStateSaveData%x_ED)) THEN +DO i1 = LBOUND(LinStateSaveData%x_ED,1), UBOUND(LinStateSaveData%x_ED,1) + CALL ED_DestroyContState( LinStateSaveData%x_ED(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(LinStateSaveData%x_ED) +ENDIF +IF (ALLOCATED(LinStateSaveData%xd_ED)) THEN +DO i1 = LBOUND(LinStateSaveData%xd_ED,1), UBOUND(LinStateSaveData%xd_ED,1) + CALL ED_DestroyDiscState( LinStateSaveData%xd_ED(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(LinStateSaveData%xd_ED) +ENDIF +IF (ALLOCATED(LinStateSaveData%z_ED)) THEN +DO i1 = LBOUND(LinStateSaveData%z_ED,1), UBOUND(LinStateSaveData%z_ED,1) + CALL ED_DestroyConstrState( LinStateSaveData%z_ED(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(LinStateSaveData%z_ED) +ENDIF +IF (ALLOCATED(LinStateSaveData%OtherSt_ED)) THEN +DO i1 = LBOUND(LinStateSaveData%OtherSt_ED,1), UBOUND(LinStateSaveData%OtherSt_ED,1) + CALL ED_DestroyOtherState( LinStateSaveData%OtherSt_ED(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(LinStateSaveData%OtherSt_ED) +ENDIF +IF (ALLOCATED(LinStateSaveData%u_ED)) THEN +DO i1 = LBOUND(LinStateSaveData%u_ED,1), UBOUND(LinStateSaveData%u_ED,1) + CALL ED_DestroyInput( LinStateSaveData%u_ED(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(LinStateSaveData%u_ED) +ENDIF +IF (ALLOCATED(LinStateSaveData%x_SrvD)) THEN +DO i1 = LBOUND(LinStateSaveData%x_SrvD,1), UBOUND(LinStateSaveData%x_SrvD,1) + CALL SrvD_DestroyContState( LinStateSaveData%x_SrvD(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(LinStateSaveData%x_SrvD) +ENDIF +IF (ALLOCATED(LinStateSaveData%xd_SrvD)) THEN +DO i1 = LBOUND(LinStateSaveData%xd_SrvD,1), UBOUND(LinStateSaveData%xd_SrvD,1) + CALL SrvD_DestroyDiscState( LinStateSaveData%xd_SrvD(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(LinStateSaveData%xd_SrvD) +ENDIF +IF (ALLOCATED(LinStateSaveData%z_SrvD)) THEN +DO i1 = LBOUND(LinStateSaveData%z_SrvD,1), UBOUND(LinStateSaveData%z_SrvD,1) + CALL SrvD_DestroyConstrState( LinStateSaveData%z_SrvD(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(LinStateSaveData%z_SrvD) +ENDIF +IF (ALLOCATED(LinStateSaveData%OtherSt_SrvD)) THEN +DO i1 = LBOUND(LinStateSaveData%OtherSt_SrvD,1), UBOUND(LinStateSaveData%OtherSt_SrvD,1) + CALL SrvD_DestroyOtherState( LinStateSaveData%OtherSt_SrvD(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(LinStateSaveData%OtherSt_SrvD) +ENDIF +IF (ALLOCATED(LinStateSaveData%u_SrvD)) THEN +DO i1 = LBOUND(LinStateSaveData%u_SrvD,1), UBOUND(LinStateSaveData%u_SrvD,1) + CALL SrvD_DestroyInput( LinStateSaveData%u_SrvD(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(LinStateSaveData%u_SrvD) +ENDIF +IF (ALLOCATED(LinStateSaveData%x_AD)) THEN +DO i1 = LBOUND(LinStateSaveData%x_AD,1), UBOUND(LinStateSaveData%x_AD,1) + CALL AD_DestroyContState( LinStateSaveData%x_AD(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(LinStateSaveData%x_AD) +ENDIF +IF (ALLOCATED(LinStateSaveData%xd_AD)) THEN +DO i1 = LBOUND(LinStateSaveData%xd_AD,1), UBOUND(LinStateSaveData%xd_AD,1) + CALL AD_DestroyDiscState( LinStateSaveData%xd_AD(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(LinStateSaveData%xd_AD) +ENDIF +IF (ALLOCATED(LinStateSaveData%z_AD)) THEN +DO i1 = LBOUND(LinStateSaveData%z_AD,1), UBOUND(LinStateSaveData%z_AD,1) + CALL AD_DestroyConstrState( LinStateSaveData%z_AD(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(LinStateSaveData%z_AD) +ENDIF +IF (ALLOCATED(LinStateSaveData%OtherSt_AD)) THEN +DO i1 = LBOUND(LinStateSaveData%OtherSt_AD,1), UBOUND(LinStateSaveData%OtherSt_AD,1) + CALL AD_DestroyOtherState( LinStateSaveData%OtherSt_AD(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(LinStateSaveData%OtherSt_AD) +ENDIF +IF (ALLOCATED(LinStateSaveData%u_AD)) THEN +DO i1 = LBOUND(LinStateSaveData%u_AD,1), UBOUND(LinStateSaveData%u_AD,1) + CALL AD_DestroyInput( LinStateSaveData%u_AD(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(LinStateSaveData%u_AD) +ENDIF +IF (ALLOCATED(LinStateSaveData%x_IfW)) THEN +DO i1 = LBOUND(LinStateSaveData%x_IfW,1), UBOUND(LinStateSaveData%x_IfW,1) + CALL InflowWind_DestroyContState( LinStateSaveData%x_IfW(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(LinStateSaveData%x_IfW) +ENDIF +IF (ALLOCATED(LinStateSaveData%xd_IfW)) THEN +DO i1 = LBOUND(LinStateSaveData%xd_IfW,1), UBOUND(LinStateSaveData%xd_IfW,1) + CALL InflowWind_DestroyDiscState( LinStateSaveData%xd_IfW(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(LinStateSaveData%xd_IfW) +ENDIF +IF (ALLOCATED(LinStateSaveData%z_IfW)) THEN +DO i1 = LBOUND(LinStateSaveData%z_IfW,1), UBOUND(LinStateSaveData%z_IfW,1) + CALL InflowWind_DestroyConstrState( LinStateSaveData%z_IfW(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(LinStateSaveData%z_IfW) +ENDIF +IF (ALLOCATED(LinStateSaveData%OtherSt_IfW)) THEN +DO i1 = LBOUND(LinStateSaveData%OtherSt_IfW,1), UBOUND(LinStateSaveData%OtherSt_IfW,1) + CALL InflowWind_DestroyOtherState( LinStateSaveData%OtherSt_IfW(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(LinStateSaveData%OtherSt_IfW) +ENDIF +IF (ALLOCATED(LinStateSaveData%u_IfW)) THEN +DO i1 = LBOUND(LinStateSaveData%u_IfW,1), UBOUND(LinStateSaveData%u_IfW,1) + CALL InflowWind_DestroyInput( LinStateSaveData%u_IfW(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(LinStateSaveData%u_IfW) +ENDIF +IF (ALLOCATED(LinStateSaveData%x_SD)) THEN +DO i1 = LBOUND(LinStateSaveData%x_SD,1), UBOUND(LinStateSaveData%x_SD,1) + CALL SD_DestroyContState( LinStateSaveData%x_SD(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(LinStateSaveData%x_SD) +ENDIF +IF (ALLOCATED(LinStateSaveData%xd_SD)) THEN +DO i1 = LBOUND(LinStateSaveData%xd_SD,1), UBOUND(LinStateSaveData%xd_SD,1) + CALL SD_DestroyDiscState( LinStateSaveData%xd_SD(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(LinStateSaveData%xd_SD) +ENDIF +IF (ALLOCATED(LinStateSaveData%z_SD)) THEN +DO i1 = LBOUND(LinStateSaveData%z_SD,1), UBOUND(LinStateSaveData%z_SD,1) + CALL SD_DestroyConstrState( LinStateSaveData%z_SD(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(LinStateSaveData%z_SD) +ENDIF +IF (ALLOCATED(LinStateSaveData%OtherSt_SD)) THEN +DO i1 = LBOUND(LinStateSaveData%OtherSt_SD,1), UBOUND(LinStateSaveData%OtherSt_SD,1) + CALL SD_DestroyOtherState( LinStateSaveData%OtherSt_SD(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(LinStateSaveData%OtherSt_SD) +ENDIF +IF (ALLOCATED(LinStateSaveData%u_SD)) THEN +DO i1 = LBOUND(LinStateSaveData%u_SD,1), UBOUND(LinStateSaveData%u_SD,1) + CALL SD_DestroyInput( LinStateSaveData%u_SD(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(LinStateSaveData%u_SD) +ENDIF +IF (ALLOCATED(LinStateSaveData%x_ExtPtfm)) THEN +DO i1 = LBOUND(LinStateSaveData%x_ExtPtfm,1), UBOUND(LinStateSaveData%x_ExtPtfm,1) + CALL ExtPtfm_DestroyContState( LinStateSaveData%x_ExtPtfm(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(LinStateSaveData%x_ExtPtfm) +ENDIF +IF (ALLOCATED(LinStateSaveData%xd_ExtPtfm)) THEN +DO i1 = LBOUND(LinStateSaveData%xd_ExtPtfm,1), UBOUND(LinStateSaveData%xd_ExtPtfm,1) + CALL ExtPtfm_DestroyDiscState( LinStateSaveData%xd_ExtPtfm(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(LinStateSaveData%xd_ExtPtfm) +ENDIF +IF (ALLOCATED(LinStateSaveData%z_ExtPtfm)) THEN +DO i1 = LBOUND(LinStateSaveData%z_ExtPtfm,1), UBOUND(LinStateSaveData%z_ExtPtfm,1) + CALL ExtPtfm_DestroyConstrState( LinStateSaveData%z_ExtPtfm(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(LinStateSaveData%z_ExtPtfm) +ENDIF +IF (ALLOCATED(LinStateSaveData%OtherSt_ExtPtfm)) THEN +DO i1 = LBOUND(LinStateSaveData%OtherSt_ExtPtfm,1), UBOUND(LinStateSaveData%OtherSt_ExtPtfm,1) + CALL ExtPtfm_DestroyOtherState( LinStateSaveData%OtherSt_ExtPtfm(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(LinStateSaveData%OtherSt_ExtPtfm) +ENDIF +IF (ALLOCATED(LinStateSaveData%u_ExtPtfm)) THEN +DO i1 = LBOUND(LinStateSaveData%u_ExtPtfm,1), UBOUND(LinStateSaveData%u_ExtPtfm,1) + CALL ExtPtfm_DestroyInput( LinStateSaveData%u_ExtPtfm(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(LinStateSaveData%u_ExtPtfm) +ENDIF +IF (ALLOCATED(LinStateSaveData%x_HD)) THEN +DO i1 = LBOUND(LinStateSaveData%x_HD,1), UBOUND(LinStateSaveData%x_HD,1) + CALL HydroDyn_DestroyContState( LinStateSaveData%x_HD(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(LinStateSaveData%x_HD) +ENDIF +IF (ALLOCATED(LinStateSaveData%xd_HD)) THEN +DO i1 = LBOUND(LinStateSaveData%xd_HD,1), UBOUND(LinStateSaveData%xd_HD,1) + CALL HydroDyn_DestroyDiscState( LinStateSaveData%xd_HD(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(LinStateSaveData%xd_HD) +ENDIF +IF (ALLOCATED(LinStateSaveData%z_HD)) THEN +DO i1 = LBOUND(LinStateSaveData%z_HD,1), UBOUND(LinStateSaveData%z_HD,1) + CALL HydroDyn_DestroyConstrState( LinStateSaveData%z_HD(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(LinStateSaveData%z_HD) +ENDIF +IF (ALLOCATED(LinStateSaveData%OtherSt_HD)) THEN +DO i1 = LBOUND(LinStateSaveData%OtherSt_HD,1), UBOUND(LinStateSaveData%OtherSt_HD,1) + CALL HydroDyn_DestroyOtherState( LinStateSaveData%OtherSt_HD(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(LinStateSaveData%OtherSt_HD) +ENDIF +IF (ALLOCATED(LinStateSaveData%u_HD)) THEN +DO i1 = LBOUND(LinStateSaveData%u_HD,1), UBOUND(LinStateSaveData%u_HD,1) + CALL HydroDyn_DestroyInput( LinStateSaveData%u_HD(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(LinStateSaveData%u_HD) +ENDIF +IF (ALLOCATED(LinStateSaveData%x_IceF)) THEN +DO i1 = LBOUND(LinStateSaveData%x_IceF,1), UBOUND(LinStateSaveData%x_IceF,1) + CALL IceFloe_DestroyContState( LinStateSaveData%x_IceF(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(LinStateSaveData%x_IceF) +ENDIF +IF (ALLOCATED(LinStateSaveData%xd_IceF)) THEN +DO i1 = LBOUND(LinStateSaveData%xd_IceF,1), UBOUND(LinStateSaveData%xd_IceF,1) + CALL IceFloe_DestroyDiscState( LinStateSaveData%xd_IceF(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(LinStateSaveData%xd_IceF) +ENDIF +IF (ALLOCATED(LinStateSaveData%z_IceF)) THEN +DO i1 = LBOUND(LinStateSaveData%z_IceF,1), UBOUND(LinStateSaveData%z_IceF,1) + CALL IceFloe_DestroyConstrState( LinStateSaveData%z_IceF(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(LinStateSaveData%z_IceF) +ENDIF +IF (ALLOCATED(LinStateSaveData%OtherSt_IceF)) THEN +DO i1 = LBOUND(LinStateSaveData%OtherSt_IceF,1), UBOUND(LinStateSaveData%OtherSt_IceF,1) + CALL IceFloe_DestroyOtherState( LinStateSaveData%OtherSt_IceF(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(LinStateSaveData%OtherSt_IceF) +ENDIF +IF (ALLOCATED(LinStateSaveData%u_IceF)) THEN +DO i1 = LBOUND(LinStateSaveData%u_IceF,1), UBOUND(LinStateSaveData%u_IceF,1) + CALL IceFloe_DestroyInput( LinStateSaveData%u_IceF(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(LinStateSaveData%u_IceF) +ENDIF +IF (ALLOCATED(LinStateSaveData%x_MAP)) THEN +DO i1 = LBOUND(LinStateSaveData%x_MAP,1), UBOUND(LinStateSaveData%x_MAP,1) + CALL MAP_DestroyContState( LinStateSaveData%x_MAP(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(LinStateSaveData%x_MAP) +ENDIF +IF (ALLOCATED(LinStateSaveData%xd_MAP)) THEN +DO i1 = LBOUND(LinStateSaveData%xd_MAP,1), UBOUND(LinStateSaveData%xd_MAP,1) + CALL MAP_DestroyDiscState( LinStateSaveData%xd_MAP(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(LinStateSaveData%xd_MAP) +ENDIF +IF (ALLOCATED(LinStateSaveData%z_MAP)) THEN +DO i1 = LBOUND(LinStateSaveData%z_MAP,1), UBOUND(LinStateSaveData%z_MAP,1) + CALL MAP_DestroyConstrState( LinStateSaveData%z_MAP(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(LinStateSaveData%z_MAP) +ENDIF +IF (ALLOCATED(LinStateSaveData%u_MAP)) THEN +DO i1 = LBOUND(LinStateSaveData%u_MAP,1), UBOUND(LinStateSaveData%u_MAP,1) + CALL MAP_DestroyInput( LinStateSaveData%u_MAP(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(LinStateSaveData%u_MAP) +ENDIF +IF (ALLOCATED(LinStateSaveData%x_FEAM)) THEN +DO i1 = LBOUND(LinStateSaveData%x_FEAM,1), UBOUND(LinStateSaveData%x_FEAM,1) + CALL FEAM_DestroyContState( LinStateSaveData%x_FEAM(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(LinStateSaveData%x_FEAM) +ENDIF +IF (ALLOCATED(LinStateSaveData%xd_FEAM)) THEN +DO i1 = LBOUND(LinStateSaveData%xd_FEAM,1), UBOUND(LinStateSaveData%xd_FEAM,1) + CALL FEAM_DestroyDiscState( LinStateSaveData%xd_FEAM(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(LinStateSaveData%xd_FEAM) +ENDIF +IF (ALLOCATED(LinStateSaveData%z_FEAM)) THEN +DO i1 = LBOUND(LinStateSaveData%z_FEAM,1), UBOUND(LinStateSaveData%z_FEAM,1) + CALL FEAM_DestroyConstrState( LinStateSaveData%z_FEAM(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(LinStateSaveData%z_FEAM) +ENDIF +IF (ALLOCATED(LinStateSaveData%OtherSt_FEAM)) THEN +DO i1 = LBOUND(LinStateSaveData%OtherSt_FEAM,1), UBOUND(LinStateSaveData%OtherSt_FEAM,1) + CALL FEAM_DestroyOtherState( LinStateSaveData%OtherSt_FEAM(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(LinStateSaveData%OtherSt_FEAM) +ENDIF +IF (ALLOCATED(LinStateSaveData%u_FEAM)) THEN +DO i1 = LBOUND(LinStateSaveData%u_FEAM,1), UBOUND(LinStateSaveData%u_FEAM,1) + CALL FEAM_DestroyInput( LinStateSaveData%u_FEAM(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(LinStateSaveData%u_FEAM) +ENDIF +IF (ALLOCATED(LinStateSaveData%x_MD)) THEN +DO i1 = LBOUND(LinStateSaveData%x_MD,1), UBOUND(LinStateSaveData%x_MD,1) + CALL MD_DestroyContState( LinStateSaveData%x_MD(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(LinStateSaveData%x_MD) +ENDIF +IF (ALLOCATED(LinStateSaveData%xd_MD)) THEN +DO i1 = LBOUND(LinStateSaveData%xd_MD,1), UBOUND(LinStateSaveData%xd_MD,1) + CALL MD_DestroyDiscState( LinStateSaveData%xd_MD(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(LinStateSaveData%xd_MD) +ENDIF +IF (ALLOCATED(LinStateSaveData%z_MD)) THEN +DO i1 = LBOUND(LinStateSaveData%z_MD,1), UBOUND(LinStateSaveData%z_MD,1) + CALL MD_DestroyConstrState( LinStateSaveData%z_MD(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(LinStateSaveData%z_MD) +ENDIF +IF (ALLOCATED(LinStateSaveData%OtherSt_MD)) THEN +DO i1 = LBOUND(LinStateSaveData%OtherSt_MD,1), UBOUND(LinStateSaveData%OtherSt_MD,1) + CALL MD_DestroyOtherState( LinStateSaveData%OtherSt_MD(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(LinStateSaveData%OtherSt_MD) +ENDIF +IF (ALLOCATED(LinStateSaveData%u_MD)) THEN +DO i1 = LBOUND(LinStateSaveData%u_MD,1), UBOUND(LinStateSaveData%u_MD,1) + CALL MD_DestroyInput( LinStateSaveData%u_MD(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(LinStateSaveData%u_MD) +ENDIF + END SUBROUTINE FAST_DestroyLinStateSave - IF ( .NOT. ALLOCATED(InData%Names_u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Names_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Names_u,1) - Int_Xferred = Int_Xferred + 2 + SUBROUTINE FAST_PackLinStateSave( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(FAST_LinStateSave), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackLinStateSave' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - DO i1 = LBOUND(InData%Names_u,1), UBOUND(InData%Names_u,1) - DO I = 1, LEN(InData%Names_u) - IntKiBuf(Int_Xferred) = ICHAR(InData%Names_u(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - END IF - IF ( .NOT. ALLOCATED(InData%Names_y) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Names_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Names_y,1) - Int_Xferred = Int_Xferred + 2 + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! x_IceD allocated yes/no + IF ( ALLOCATED(InData%x_IceD) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! x_IceD upper/lower bounds for each dimension + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + DO i2 = LBOUND(InData%x_IceD,2), UBOUND(InData%x_IceD,2) + DO i1 = LBOUND(InData%x_IceD,1), UBOUND(InData%x_IceD,1) + Int_BufSz = Int_BufSz + 3 ! x_IceD: size of buffers for each call to pack subtype + CALL IceD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_IceD(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! x_IceD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - DO i1 = LBOUND(InData%Names_y,1), UBOUND(InData%Names_y,1) - DO I = 1, LEN(InData%Names_y) - IntKiBuf(Int_Xferred) = ICHAR(InData%Names_y(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 + IF(ALLOCATED(Re_Buf)) THEN ! x_IceD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! x_IceD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! x_IceD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END DO END IF - IF ( .NOT. ALLOCATED(InData%Names_x) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Names_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Names_x,1) - Int_Xferred = Int_Xferred + 2 + Int_BufSz = Int_BufSz + 1 ! xd_IceD allocated yes/no + IF ( ALLOCATED(InData%xd_IceD) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! xd_IceD upper/lower bounds for each dimension + DO i2 = LBOUND(InData%xd_IceD,2), UBOUND(InData%xd_IceD,2) + DO i1 = LBOUND(InData%xd_IceD,1), UBOUND(InData%xd_IceD,1) + Int_BufSz = Int_BufSz + 3 ! xd_IceD: size of buffers for each call to pack subtype + CALL IceD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_IceD(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! xd_IceD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - DO i1 = LBOUND(InData%Names_x,1), UBOUND(InData%Names_x,1) - DO I = 1, LEN(InData%Names_x) - IntKiBuf(Int_Xferred) = ICHAR(InData%Names_x(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 + IF(ALLOCATED(Re_Buf)) THEN ! xd_IceD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! xd_IceD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! xd_IceD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END DO END IF - IF ( .NOT. ALLOCATED(InData%Names_xd) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Names_xd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Names_xd,1) - Int_Xferred = Int_Xferred + 2 + Int_BufSz = Int_BufSz + 1 ! z_IceD allocated yes/no + IF ( ALLOCATED(InData%z_IceD) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! z_IceD upper/lower bounds for each dimension + DO i2 = LBOUND(InData%z_IceD,2), UBOUND(InData%z_IceD,2) + DO i1 = LBOUND(InData%z_IceD,1), UBOUND(InData%z_IceD,1) + Int_BufSz = Int_BufSz + 3 ! z_IceD: size of buffers for each call to pack subtype + CALL IceD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_IceD(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! z_IceD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - DO i1 = LBOUND(InData%Names_xd,1), UBOUND(InData%Names_xd,1) - DO I = 1, LEN(InData%Names_xd) - IntKiBuf(Int_Xferred) = ICHAR(InData%Names_xd(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 + IF(ALLOCATED(Re_Buf)) THEN ! z_IceD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! z_IceD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! z_IceD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END DO END IF - IF ( .NOT. ALLOCATED(InData%Names_z) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Names_z,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Names_z,1) - Int_Xferred = Int_Xferred + 2 + Int_BufSz = Int_BufSz + 1 ! OtherSt_IceD allocated yes/no + IF ( ALLOCATED(InData%OtherSt_IceD) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! OtherSt_IceD upper/lower bounds for each dimension + DO i2 = LBOUND(InData%OtherSt_IceD,2), UBOUND(InData%OtherSt_IceD,2) + DO i1 = LBOUND(InData%OtherSt_IceD,1), UBOUND(InData%OtherSt_IceD,1) + Int_BufSz = Int_BufSz + 3 ! OtherSt_IceD: size of buffers for each call to pack subtype + CALL IceD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_IceD(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt_IceD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - DO i1 = LBOUND(InData%Names_z,1), UBOUND(InData%Names_z,1) - DO I = 1, LEN(InData%Names_z) - IntKiBuf(Int_Xferred) = ICHAR(InData%Names_z(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 + IF(ALLOCATED(Re_Buf)) THEN ! OtherSt_IceD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OtherSt_IceD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OtherSt_IceD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END DO END IF - IF ( .NOT. ALLOCATED(InData%op_u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%op_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%op_u,1) - Int_Xferred = Int_Xferred + 2 + Int_BufSz = Int_BufSz + 1 ! u_IceD allocated yes/no + IF ( ALLOCATED(InData%u_IceD) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! u_IceD upper/lower bounds for each dimension + DO i2 = LBOUND(InData%u_IceD,2), UBOUND(InData%u_IceD,2) + DO i1 = LBOUND(InData%u_IceD,1), UBOUND(InData%u_IceD,1) + Int_BufSz = Int_BufSz + 3 ! u_IceD: size of buffers for each call to pack subtype + CALL IceD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_IceD(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! u_IceD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - IF (SIZE(InData%op_u)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%op_u))-1 ) = PACK(InData%op_u,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%op_u) + IF(ALLOCATED(Re_Buf)) THEN ! u_IceD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u_IceD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u_IceD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END DO END IF - IF ( .NOT. ALLOCATED(InData%op_y) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%op_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%op_y,1) - Int_Xferred = Int_Xferred + 2 + Int_BufSz = Int_BufSz + 1 ! x_BD allocated yes/no + IF ( ALLOCATED(InData%x_BD) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! x_BD upper/lower bounds for each dimension + DO i2 = LBOUND(InData%x_BD,2), UBOUND(InData%x_BD,2) + DO i1 = LBOUND(InData%x_BD,1), UBOUND(InData%x_BD,1) + Int_BufSz = Int_BufSz + 3 ! x_BD: size of buffers for each call to pack subtype + CALL BD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_BD(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! x_BD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - IF (SIZE(InData%op_y)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%op_y))-1 ) = PACK(InData%op_y,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%op_y) + IF(ALLOCATED(Re_Buf)) THEN ! x_BD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! x_BD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! x_BD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END DO END IF - IF ( .NOT. ALLOCATED(InData%op_x) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%op_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%op_x,1) - Int_Xferred = Int_Xferred + 2 + Int_BufSz = Int_BufSz + 1 ! xd_BD allocated yes/no + IF ( ALLOCATED(InData%xd_BD) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! xd_BD upper/lower bounds for each dimension + DO i2 = LBOUND(InData%xd_BD,2), UBOUND(InData%xd_BD,2) + DO i1 = LBOUND(InData%xd_BD,1), UBOUND(InData%xd_BD,1) + Int_BufSz = Int_BufSz + 3 ! xd_BD: size of buffers for each call to pack subtype + CALL BD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_BD(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! xd_BD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - IF (SIZE(InData%op_x)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%op_x))-1 ) = PACK(InData%op_x,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%op_x) + IF(ALLOCATED(Re_Buf)) THEN ! xd_BD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! xd_BD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! xd_BD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END DO END IF - IF ( .NOT. ALLOCATED(InData%op_dx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%op_dx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%op_dx,1) - Int_Xferred = Int_Xferred + 2 + Int_BufSz = Int_BufSz + 1 ! z_BD allocated yes/no + IF ( ALLOCATED(InData%z_BD) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! z_BD upper/lower bounds for each dimension + DO i2 = LBOUND(InData%z_BD,2), UBOUND(InData%z_BD,2) + DO i1 = LBOUND(InData%z_BD,1), UBOUND(InData%z_BD,1) + Int_BufSz = Int_BufSz + 3 ! z_BD: size of buffers for each call to pack subtype + CALL BD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_BD(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! z_BD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - IF (SIZE(InData%op_dx)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%op_dx))-1 ) = PACK(InData%op_dx,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%op_dx) + IF(ALLOCATED(Re_Buf)) THEN ! z_BD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! z_BD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! z_BD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END DO END IF - IF ( .NOT. ALLOCATED(InData%op_xd) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%op_xd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%op_xd,1) - Int_Xferred = Int_Xferred + 2 + Int_BufSz = Int_BufSz + 1 ! OtherSt_BD allocated yes/no + IF ( ALLOCATED(InData%OtherSt_BD) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! OtherSt_BD upper/lower bounds for each dimension + DO i2 = LBOUND(InData%OtherSt_BD,2), UBOUND(InData%OtherSt_BD,2) + DO i1 = LBOUND(InData%OtherSt_BD,1), UBOUND(InData%OtherSt_BD,1) + Int_BufSz = Int_BufSz + 3 ! OtherSt_BD: size of buffers for each call to pack subtype + CALL BD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_BD(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt_BD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - IF (SIZE(InData%op_xd)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%op_xd))-1 ) = PACK(InData%op_xd,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%op_xd) + IF(ALLOCATED(Re_Buf)) THEN ! OtherSt_BD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OtherSt_BD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OtherSt_BD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END DO END IF - IF ( .NOT. ALLOCATED(InData%op_z) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%op_z,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%op_z,1) - Int_Xferred = Int_Xferred + 2 + Int_BufSz = Int_BufSz + 1 ! u_BD allocated yes/no + IF ( ALLOCATED(InData%u_BD) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! u_BD upper/lower bounds for each dimension + DO i2 = LBOUND(InData%u_BD,2), UBOUND(InData%u_BD,2) + DO i1 = LBOUND(InData%u_BD,1), UBOUND(InData%u_BD,1) + Int_BufSz = Int_BufSz + 3 ! u_BD: size of buffers for each call to pack subtype + CALL BD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_BD(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! u_BD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - IF (SIZE(InData%op_z)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%op_z))-1 ) = PACK(InData%op_z,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%op_z) - END IF - IF ( .NOT. ALLOCATED(InData%Use_u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Use_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Use_u,1) - Int_Xferred = Int_Xferred + 2 + IF(ALLOCATED(Re_Buf)) THEN ! u_BD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u_BD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u_BD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! x_ED allocated yes/no + IF ( ALLOCATED(InData%x_ED) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! x_ED upper/lower bounds for each dimension + DO i1 = LBOUND(InData%x_ED,1), UBOUND(InData%x_ED,1) + Int_BufSz = Int_BufSz + 3 ! x_ED: size of buffers for each call to pack subtype + CALL ED_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_ED(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x_ED + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - IF (SIZE(InData%Use_u)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%Use_u)-1 ) = TRANSFER(PACK( InData%Use_u ,.TRUE.), IntKiBuf(1), SIZE(InData%Use_u)) - Int_Xferred = Int_Xferred + SIZE(InData%Use_u) + IF(ALLOCATED(Re_Buf)) THEN ! x_ED + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! x_ED + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! x_ED + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO END IF - IF ( .NOT. ALLOCATED(InData%Use_y) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Use_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Use_y,1) - Int_Xferred = Int_Xferred + 2 + Int_BufSz = Int_BufSz + 1 ! xd_ED allocated yes/no + IF ( ALLOCATED(InData%xd_ED) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! xd_ED upper/lower bounds for each dimension + DO i1 = LBOUND(InData%xd_ED,1), UBOUND(InData%xd_ED,1) + Int_BufSz = Int_BufSz + 3 ! xd_ED: size of buffers for each call to pack subtype + CALL ED_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_ED(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd_ED + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - IF (SIZE(InData%Use_y)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%Use_y)-1 ) = TRANSFER(PACK( InData%Use_y ,.TRUE.), IntKiBuf(1), SIZE(InData%Use_y)) - Int_Xferred = Int_Xferred + SIZE(InData%Use_y) + IF(ALLOCATED(Re_Buf)) THEN ! xd_ED + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! xd_ED + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! xd_ED + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO END IF - IF ( .NOT. ALLOCATED(InData%A) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%A,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%A,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%A,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%A,2) - Int_Xferred = Int_Xferred + 2 + Int_BufSz = Int_BufSz + 1 ! z_ED allocated yes/no + IF ( ALLOCATED(InData%z_ED) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! z_ED upper/lower bounds for each dimension + DO i1 = LBOUND(InData%z_ED,1), UBOUND(InData%z_ED,1) + Int_BufSz = Int_BufSz + 3 ! z_ED: size of buffers for each call to pack subtype + CALL ED_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_ED(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z_ED + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - IF (SIZE(InData%A)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%A))-1 ) = PACK(InData%A,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%A) + IF(ALLOCATED(Re_Buf)) THEN ! z_ED + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! z_ED + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! z_ED + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO END IF - IF ( .NOT. ALLOCATED(InData%B) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%B,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%B,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%B,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%B,2) - Int_Xferred = Int_Xferred + 2 + Int_BufSz = Int_BufSz + 1 ! OtherSt_ED allocated yes/no + IF ( ALLOCATED(InData%OtherSt_ED) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! OtherSt_ED upper/lower bounds for each dimension + DO i1 = LBOUND(InData%OtherSt_ED,1), UBOUND(InData%OtherSt_ED,1) + Int_BufSz = Int_BufSz + 3 ! OtherSt_ED: size of buffers for each call to pack subtype + CALL ED_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_ED(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt_ED + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - IF (SIZE(InData%B)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%B))-1 ) = PACK(InData%B,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%B) + IF(ALLOCATED(Re_Buf)) THEN ! OtherSt_ED + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OtherSt_ED + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OtherSt_ED + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO END IF - IF ( .NOT. ALLOCATED(InData%C) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%C,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C,2) - Int_Xferred = Int_Xferred + 2 + Int_BufSz = Int_BufSz + 1 ! u_ED allocated yes/no + IF ( ALLOCATED(InData%u_ED) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! u_ED upper/lower bounds for each dimension + DO i1 = LBOUND(InData%u_ED,1), UBOUND(InData%u_ED,1) + Int_BufSz = Int_BufSz + 3 ! u_ED: size of buffers for each call to pack subtype + CALL ED_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_ED(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_ED + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - IF (SIZE(InData%C)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%C))-1 ) = PACK(InData%C,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%C) + IF(ALLOCATED(Re_Buf)) THEN ! u_ED + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u_ED + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u_ED + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO END IF - IF ( .NOT. ALLOCATED(InData%D) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%D,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%D,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D,2) - Int_Xferred = Int_Xferred + 2 + Int_BufSz = Int_BufSz + 1 ! x_SrvD allocated yes/no + IF ( ALLOCATED(InData%x_SrvD) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! x_SrvD upper/lower bounds for each dimension + DO i1 = LBOUND(InData%x_SrvD,1), UBOUND(InData%x_SrvD,1) + Int_BufSz = Int_BufSz + 3 ! x_SrvD: size of buffers for each call to pack subtype + CALL SrvD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_SrvD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x_SrvD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - IF (SIZE(InData%D)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%D))-1 ) = PACK(InData%D,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%D) + IF(ALLOCATED(Re_Buf)) THEN ! x_SrvD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! x_SrvD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! x_SrvD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO END IF - IF ( .NOT. ALLOCATED(InData%StateRotation) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StateRotation,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StateRotation,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StateRotation,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StateRotation,2) - Int_Xferred = Int_Xferred + 2 + Int_BufSz = Int_BufSz + 1 ! xd_SrvD allocated yes/no + IF ( ALLOCATED(InData%xd_SrvD) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! xd_SrvD upper/lower bounds for each dimension + DO i1 = LBOUND(InData%xd_SrvD,1), UBOUND(InData%xd_SrvD,1) + Int_BufSz = Int_BufSz + 3 ! xd_SrvD: size of buffers for each call to pack subtype + CALL SrvD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_SrvD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd_SrvD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - IF (SIZE(InData%StateRotation)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%StateRotation))-1 ) = PACK(InData%StateRotation,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%StateRotation) + IF(ALLOCATED(Re_Buf)) THEN ! xd_SrvD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! xd_SrvD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! xd_SrvD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO END IF - IF ( .NOT. ALLOCATED(InData%StateRel_x) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StateRel_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StateRel_x,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StateRel_x,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StateRel_x,2) - Int_Xferred = Int_Xferred + 2 + Int_BufSz = Int_BufSz + 1 ! z_SrvD allocated yes/no + IF ( ALLOCATED(InData%z_SrvD) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! z_SrvD upper/lower bounds for each dimension + DO i1 = LBOUND(InData%z_SrvD,1), UBOUND(InData%z_SrvD,1) + Int_BufSz = Int_BufSz + 3 ! z_SrvD: size of buffers for each call to pack subtype + CALL SrvD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_SrvD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z_SrvD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - IF (SIZE(InData%StateRel_x)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%StateRel_x))-1 ) = PACK(InData%StateRel_x,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%StateRel_x) + IF(ALLOCATED(Re_Buf)) THEN ! z_SrvD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! z_SrvD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! z_SrvD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO END IF - IF ( .NOT. ALLOCATED(InData%StateRel_xdot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StateRel_xdot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StateRel_xdot,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%StateRel_xdot,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StateRel_xdot,2) - Int_Xferred = Int_Xferred + 2 + Int_BufSz = Int_BufSz + 1 ! OtherSt_SrvD allocated yes/no + IF ( ALLOCATED(InData%OtherSt_SrvD) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! OtherSt_SrvD upper/lower bounds for each dimension + DO i1 = LBOUND(InData%OtherSt_SrvD,1), UBOUND(InData%OtherSt_SrvD,1) + Int_BufSz = Int_BufSz + 3 ! OtherSt_SrvD: size of buffers for each call to pack subtype + CALL SrvD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_SrvD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt_SrvD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - IF (SIZE(InData%StateRel_xdot)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%StateRel_xdot))-1 ) = PACK(InData%StateRel_xdot,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%StateRel_xdot) + IF(ALLOCATED(Re_Buf)) THEN ! OtherSt_SrvD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OtherSt_SrvD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OtherSt_SrvD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO END IF - 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 + Int_BufSz = Int_BufSz + 1 ! u_SrvD allocated yes/no + IF ( ALLOCATED(InData%u_SrvD) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! u_SrvD upper/lower bounds for each dimension + DO i1 = LBOUND(InData%u_SrvD,1), UBOUND(InData%u_SrvD,1) + Int_BufSz = Int_BufSz + 3 ! u_SrvD: size of buffers for each call to pack subtype + CALL SrvD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_SrvD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_SrvD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - IF (SIZE(InData%IsLoad_u)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%IsLoad_u)-1 ) = TRANSFER(PACK( InData%IsLoad_u ,.TRUE.), IntKiBuf(1), SIZE(InData%IsLoad_u)) - Int_Xferred = Int_Xferred + SIZE(InData%IsLoad_u) + IF(ALLOCATED(Re_Buf)) THEN ! u_SrvD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u_SrvD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u_SrvD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO END IF - IF ( .NOT. ALLOCATED(InData%RotFrame_u) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RotFrame_u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_u,1) - Int_Xferred = Int_Xferred + 2 + Int_BufSz = Int_BufSz + 1 ! x_AD allocated yes/no + IF ( ALLOCATED(InData%x_AD) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! x_AD upper/lower bounds for each dimension + DO i1 = LBOUND(InData%x_AD,1), UBOUND(InData%x_AD,1) + Int_BufSz = Int_BufSz + 3 ! x_AD: size of buffers for each call to pack subtype + CALL AD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_AD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x_AD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - IF (SIZE(InData%RotFrame_u)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%RotFrame_u)-1 ) = TRANSFER(PACK( InData%RotFrame_u ,.TRUE.), IntKiBuf(1), SIZE(InData%RotFrame_u)) - Int_Xferred = Int_Xferred + SIZE(InData%RotFrame_u) + IF(ALLOCATED(Re_Buf)) THEN ! x_AD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! x_AD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! x_AD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO END IF - IF ( .NOT. ALLOCATED(InData%RotFrame_y) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RotFrame_y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_y,1) - Int_Xferred = Int_Xferred + 2 + Int_BufSz = Int_BufSz + 1 ! xd_AD allocated yes/no + IF ( ALLOCATED(InData%xd_AD) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! xd_AD upper/lower bounds for each dimension + DO i1 = LBOUND(InData%xd_AD,1), UBOUND(InData%xd_AD,1) + Int_BufSz = Int_BufSz + 3 ! xd_AD: size of buffers for each call to pack subtype + CALL AD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_AD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd_AD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - IF (SIZE(InData%RotFrame_y)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%RotFrame_y)-1 ) = TRANSFER(PACK( InData%RotFrame_y ,.TRUE.), IntKiBuf(1), SIZE(InData%RotFrame_y)) - Int_Xferred = Int_Xferred + SIZE(InData%RotFrame_y) + IF(ALLOCATED(Re_Buf)) THEN ! xd_AD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! xd_AD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! xd_AD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO END IF - IF ( .NOT. ALLOCATED(InData%RotFrame_x) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RotFrame_x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_x,1) - Int_Xferred = Int_Xferred + 2 + Int_BufSz = Int_BufSz + 1 ! z_AD allocated yes/no + IF ( ALLOCATED(InData%z_AD) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! z_AD upper/lower bounds for each dimension + DO i1 = LBOUND(InData%z_AD,1), UBOUND(InData%z_AD,1) + Int_BufSz = Int_BufSz + 3 ! z_AD: size of buffers for each call to pack subtype + CALL AD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_AD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z_AD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - IF (SIZE(InData%RotFrame_x)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%RotFrame_x)-1 ) = TRANSFER(PACK( InData%RotFrame_x ,.TRUE.), IntKiBuf(1), SIZE(InData%RotFrame_x)) - Int_Xferred = Int_Xferred + SIZE(InData%RotFrame_x) + IF(ALLOCATED(Re_Buf)) THEN ! z_AD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! z_AD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! z_AD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO END IF - IF ( .NOT. ALLOCATED(InData%RotFrame_z) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%RotFrame_z,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_z,1) - Int_Xferred = Int_Xferred + 2 + Int_BufSz = Int_BufSz + 1 ! OtherSt_AD allocated yes/no + IF ( ALLOCATED(InData%OtherSt_AD) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! OtherSt_AD upper/lower bounds for each dimension + DO i1 = LBOUND(InData%OtherSt_AD,1), UBOUND(InData%OtherSt_AD,1) + Int_BufSz = Int_BufSz + 3 ! OtherSt_AD: size of buffers for each call to pack subtype + CALL AD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_AD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt_AD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - IF (SIZE(InData%RotFrame_z)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%RotFrame_z)-1 ) = TRANSFER(PACK( InData%RotFrame_z ,.TRUE.), IntKiBuf(1), SIZE(InData%RotFrame_z)) - Int_Xferred = Int_Xferred + SIZE(InData%RotFrame_z) + IF(ALLOCATED(Re_Buf)) THEN ! OtherSt_AD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OtherSt_AD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OtherSt_AD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO END IF - 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 + Int_BufSz = Int_BufSz + 1 ! u_AD allocated yes/no + IF ( ALLOCATED(InData%u_AD) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! u_AD upper/lower bounds for each dimension + DO i1 = LBOUND(InData%u_AD,1), UBOUND(InData%u_AD,1) + Int_BufSz = Int_BufSz + 3 ! u_AD: size of buffers for each call to pack subtype + CALL AD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_AD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_AD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - IF (SIZE(InData%DerivOrder_x)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%DerivOrder_x))-1 ) = PACK(InData%DerivOrder_x,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%DerivOrder_x) + IF(ALLOCATED(Re_Buf)) THEN ! u_AD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u_AD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u_AD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%SizeLin))-1 ) = PACK(InData%SizeLin,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%SizeLin) - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%LinStartIndx))-1 ) = PACK(InData%LinStartIndx,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%LinStartIndx) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOutputs - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FAST_PackLinType + Int_BufSz = Int_BufSz + 1 ! x_IfW allocated yes/no + IF ( ALLOCATED(InData%x_IfW) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! x_IfW upper/lower bounds for each dimension + DO i1 = LBOUND(InData%x_IfW,1), UBOUND(InData%x_IfW,1) + Int_BufSz = Int_BufSz + 3 ! x_IfW: size of buffers for each call to pack subtype + CALL InflowWind_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_IfW(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x_IfW + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - SUBROUTINE FAST_UnPackLinType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FAST_LinType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackLinType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Names_u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Names_u)) DEALLOCATE(OutData%Names_u) - ALLOCATE(OutData%Names_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Names_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%Names_u,1), UBOUND(OutData%Names_u,1) - DO I = 1, LEN(OutData%Names_u) - OutData%Names_u(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - DEALLOCATE(mask1) + IF(ALLOCATED(Re_Buf)) THEN ! x_IfW + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! x_IfW + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! x_IfW + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Names_y not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Names_y)) DEALLOCATE(OutData%Names_y) - ALLOCATE(OutData%Names_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Names_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%Names_y,1), UBOUND(OutData%Names_y,1) - DO I = 1, LEN(OutData%Names_y) - OutData%Names_y(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - DEALLOCATE(mask1) + Int_BufSz = Int_BufSz + 1 ! xd_IfW allocated yes/no + IF ( ALLOCATED(InData%xd_IfW) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! xd_IfW upper/lower bounds for each dimension + DO i1 = LBOUND(InData%xd_IfW,1), UBOUND(InData%xd_IfW,1) + Int_BufSz = Int_BufSz + 3 ! xd_IfW: size of buffers for each call to pack subtype + CALL InflowWind_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_IfW(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd_IfW + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! xd_IfW + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! xd_IfW + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! xd_IfW + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Names_x not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Names_x)) DEALLOCATE(OutData%Names_x) - ALLOCATE(OutData%Names_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Names_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%Names_x,1), UBOUND(OutData%Names_x,1) - DO I = 1, LEN(OutData%Names_x) - OutData%Names_x(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - DEALLOCATE(mask1) + Int_BufSz = Int_BufSz + 1 ! z_IfW allocated yes/no + IF ( ALLOCATED(InData%z_IfW) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! z_IfW upper/lower bounds for each dimension + DO i1 = LBOUND(InData%z_IfW,1), UBOUND(InData%z_IfW,1) + Int_BufSz = Int_BufSz + 3 ! z_IfW: size of buffers for each call to pack subtype + CALL InflowWind_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_IfW(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z_IfW + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! z_IfW + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! z_IfW + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! z_IfW + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Names_xd not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Names_xd)) DEALLOCATE(OutData%Names_xd) - ALLOCATE(OutData%Names_xd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Names_xd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%Names_xd,1), UBOUND(OutData%Names_xd,1) - DO I = 1, LEN(OutData%Names_xd) - OutData%Names_xd(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - DEALLOCATE(mask1) + Int_BufSz = Int_BufSz + 1 ! OtherSt_IfW allocated yes/no + IF ( ALLOCATED(InData%OtherSt_IfW) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! OtherSt_IfW upper/lower bounds for each dimension + DO i1 = LBOUND(InData%OtherSt_IfW,1), UBOUND(InData%OtherSt_IfW,1) + Int_BufSz = Int_BufSz + 3 ! OtherSt_IfW: size of buffers for each call to pack subtype + CALL InflowWind_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_IfW(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt_IfW + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! OtherSt_IfW + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OtherSt_IfW + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OtherSt_IfW + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Names_z not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Names_z)) DEALLOCATE(OutData%Names_z) - ALLOCATE(OutData%Names_z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Names_z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%Names_z,1), UBOUND(OutData%Names_z,1) - DO I = 1, LEN(OutData%Names_z) - OutData%Names_z(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - DEALLOCATE(mask1) + Int_BufSz = Int_BufSz + 1 ! u_IfW allocated yes/no + IF ( ALLOCATED(InData%u_IfW) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! u_IfW upper/lower bounds for each dimension + DO i1 = LBOUND(InData%u_IfW,1), UBOUND(InData%u_IfW,1) + Int_BufSz = Int_BufSz + 3 ! u_IfW: size of buffers for each call to pack subtype + CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_IfW(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_IfW + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u_IfW + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u_IfW + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u_IfW + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! op_u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%op_u)) DEALLOCATE(OutData%op_u) - ALLOCATE(OutData%op_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%op_u)>0) OutData%op_u = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%op_u))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%op_u) - DEALLOCATE(mask1) + Int_BufSz = Int_BufSz + 1 ! x_SD allocated yes/no + IF ( ALLOCATED(InData%x_SD) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! x_SD upper/lower bounds for each dimension + DO i1 = LBOUND(InData%x_SD,1), UBOUND(InData%x_SD,1) + Int_BufSz = Int_BufSz + 3 ! x_SD: size of buffers for each call to pack subtype + CALL SD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_SD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x_SD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! x_SD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! x_SD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! x_SD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! op_y not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%op_y)) DEALLOCATE(OutData%op_y) - ALLOCATE(OutData%op_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%op_y)>0) OutData%op_y = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%op_y))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%op_y) - DEALLOCATE(mask1) + Int_BufSz = Int_BufSz + 1 ! xd_SD allocated yes/no + IF ( ALLOCATED(InData%xd_SD) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! xd_SD upper/lower bounds for each dimension + DO i1 = LBOUND(InData%xd_SD,1), UBOUND(InData%xd_SD,1) + Int_BufSz = Int_BufSz + 3 ! xd_SD: size of buffers for each call to pack subtype + CALL SD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_SD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd_SD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! xd_SD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! xd_SD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! xd_SD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! op_x not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%op_x)) DEALLOCATE(OutData%op_x) - ALLOCATE(OutData%op_x(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%op_x)>0) OutData%op_x = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%op_x))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%op_x) - DEALLOCATE(mask1) + Int_BufSz = Int_BufSz + 1 ! z_SD allocated yes/no + IF ( ALLOCATED(InData%z_SD) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! z_SD upper/lower bounds for each dimension + DO i1 = LBOUND(InData%z_SD,1), UBOUND(InData%z_SD,1) + Int_BufSz = Int_BufSz + 3 ! z_SD: size of buffers for each call to pack subtype + CALL SD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_SD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z_SD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! z_SD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! z_SD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! z_SD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! op_dx not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%op_dx)) DEALLOCATE(OutData%op_dx) - ALLOCATE(OutData%op_dx(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_dx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%op_dx)>0) OutData%op_dx = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%op_dx))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%op_dx) - DEALLOCATE(mask1) + Int_BufSz = Int_BufSz + 1 ! OtherSt_SD allocated yes/no + IF ( ALLOCATED(InData%OtherSt_SD) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! OtherSt_SD upper/lower bounds for each dimension + DO i1 = LBOUND(InData%OtherSt_SD,1), UBOUND(InData%OtherSt_SD,1) + Int_BufSz = Int_BufSz + 3 ! OtherSt_SD: size of buffers for each call to pack subtype + CALL SD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_SD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt_SD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! OtherSt_SD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OtherSt_SD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OtherSt_SD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! op_xd not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%op_xd)) DEALLOCATE(OutData%op_xd) - ALLOCATE(OutData%op_xd(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_xd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%op_xd)>0) OutData%op_xd = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%op_xd))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%op_xd) - DEALLOCATE(mask1) + Int_BufSz = Int_BufSz + 1 ! u_SD allocated yes/no + IF ( ALLOCATED(InData%u_SD) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! u_SD upper/lower bounds for each dimension + DO i1 = LBOUND(InData%u_SD,1), UBOUND(InData%u_SD,1) + Int_BufSz = Int_BufSz + 3 ! u_SD: size of buffers for each call to pack subtype + CALL SD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_SD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_SD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u_SD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u_SD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u_SD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! op_z not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%op_z)) DEALLOCATE(OutData%op_z) - ALLOCATE(OutData%op_z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%op_z)>0) OutData%op_z = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%op_z))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%op_z) - DEALLOCATE(mask1) + Int_BufSz = Int_BufSz + 1 ! x_ExtPtfm allocated yes/no + IF ( ALLOCATED(InData%x_ExtPtfm) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! x_ExtPtfm upper/lower bounds for each dimension + DO i1 = LBOUND(InData%x_ExtPtfm,1), UBOUND(InData%x_ExtPtfm,1) + Int_BufSz = Int_BufSz + 3 ! x_ExtPtfm: size of buffers for each call to pack subtype + CALL ExtPtfm_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_ExtPtfm(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x_ExtPtfm + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! x_ExtPtfm + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! x_ExtPtfm + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! x_ExtPtfm + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Use_u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Use_u)) DEALLOCATE(OutData%Use_u) - ALLOCATE(OutData%Use_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Use_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Use_u)>0) OutData%Use_u = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%Use_u))-1 ), OutData%Use_u), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%Use_u) - DEALLOCATE(mask1) + Int_BufSz = Int_BufSz + 1 ! xd_ExtPtfm allocated yes/no + IF ( ALLOCATED(InData%xd_ExtPtfm) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! xd_ExtPtfm upper/lower bounds for each dimension + DO i1 = LBOUND(InData%xd_ExtPtfm,1), UBOUND(InData%xd_ExtPtfm,1) + Int_BufSz = Int_BufSz + 3 ! xd_ExtPtfm: size of buffers for each call to pack subtype + CALL ExtPtfm_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_ExtPtfm(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd_ExtPtfm + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! xd_ExtPtfm + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! xd_ExtPtfm + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! xd_ExtPtfm + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Use_y not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Use_y)) DEALLOCATE(OutData%Use_y) - ALLOCATE(OutData%Use_y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Use_y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Use_y)>0) OutData%Use_y = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%Use_y))-1 ), OutData%Use_y), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%Use_y) - DEALLOCATE(mask1) + Int_BufSz = Int_BufSz + 1 ! z_ExtPtfm allocated yes/no + IF ( ALLOCATED(InData%z_ExtPtfm) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! z_ExtPtfm upper/lower bounds for each dimension + DO i1 = LBOUND(InData%z_ExtPtfm,1), UBOUND(InData%z_ExtPtfm,1) + Int_BufSz = Int_BufSz + 3 ! z_ExtPtfm: size of buffers for each call to pack subtype + CALL ExtPtfm_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_ExtPtfm(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z_ExtPtfm + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! z_ExtPtfm + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! z_ExtPtfm + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! z_ExtPtfm + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! A not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%A)) DEALLOCATE(OutData%A) - ALLOCATE(OutData%A(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%A.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%A)>0) OutData%A = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%A))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%A) - DEALLOCATE(mask2) + Int_BufSz = Int_BufSz + 1 ! OtherSt_ExtPtfm allocated yes/no + IF ( ALLOCATED(InData%OtherSt_ExtPtfm) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! OtherSt_ExtPtfm upper/lower bounds for each dimension + DO i1 = LBOUND(InData%OtherSt_ExtPtfm,1), UBOUND(InData%OtherSt_ExtPtfm,1) + Int_BufSz = Int_BufSz + 3 ! OtherSt_ExtPtfm: size of buffers for each call to pack subtype + CALL ExtPtfm_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_ExtPtfm(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt_ExtPtfm + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! OtherSt_ExtPtfm + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OtherSt_ExtPtfm + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OtherSt_ExtPtfm + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! B not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%B)) DEALLOCATE(OutData%B) - ALLOCATE(OutData%B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%B)>0) OutData%B = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%B))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%B) - DEALLOCATE(mask2) + Int_BufSz = Int_BufSz + 1 ! u_ExtPtfm allocated yes/no + IF ( ALLOCATED(InData%u_ExtPtfm) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! u_ExtPtfm upper/lower bounds for each dimension + DO i1 = LBOUND(InData%u_ExtPtfm,1), UBOUND(InData%u_ExtPtfm,1) + Int_BufSz = Int_BufSz + 3 ! u_ExtPtfm: size of buffers for each call to pack subtype + CALL ExtPtfm_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_ExtPtfm(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_ExtPtfm + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u_ExtPtfm + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u_ExtPtfm + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u_ExtPtfm + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%C)) DEALLOCATE(OutData%C) - ALLOCATE(OutData%C(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%C)>0) OutData%C = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%C))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%C) - DEALLOCATE(mask2) + Int_BufSz = Int_BufSz + 1 ! x_HD allocated yes/no + IF ( ALLOCATED(InData%x_HD) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! x_HD upper/lower bounds for each dimension + DO i1 = LBOUND(InData%x_HD,1), UBOUND(InData%x_HD,1) + Int_BufSz = Int_BufSz + 3 ! x_HD: size of buffers for each call to pack subtype + CALL HydroDyn_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_HD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x_HD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! x_HD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! x_HD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! x_HD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%D)) DEALLOCATE(OutData%D) - ALLOCATE(OutData%D(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%D)>0) OutData%D = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%D))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%D) - DEALLOCATE(mask2) + Int_BufSz = Int_BufSz + 1 ! xd_HD allocated yes/no + IF ( ALLOCATED(InData%xd_HD) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! xd_HD upper/lower bounds for each dimension + DO i1 = LBOUND(InData%xd_HD,1), UBOUND(InData%xd_HD,1) + Int_BufSz = Int_BufSz + 3 ! xd_HD: size of buffers for each call to pack subtype + CALL HydroDyn_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_HD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd_HD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! xd_HD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! xd_HD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! xd_HD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StateRotation not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%StateRotation)) DEALLOCATE(OutData%StateRotation) - ALLOCATE(OutData%StateRotation(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StateRotation.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%StateRotation)>0) OutData%StateRotation = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%StateRotation))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%StateRotation) - DEALLOCATE(mask2) + Int_BufSz = Int_BufSz + 1 ! z_HD allocated yes/no + IF ( ALLOCATED(InData%z_HD) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! z_HD upper/lower bounds for each dimension + DO i1 = LBOUND(InData%z_HD,1), UBOUND(InData%z_HD,1) + Int_BufSz = Int_BufSz + 3 ! z_HD: size of buffers for each call to pack subtype + CALL HydroDyn_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_HD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z_HD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! z_HD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! z_HD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! z_HD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StateRel_x not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%StateRel_x)) DEALLOCATE(OutData%StateRel_x) - ALLOCATE(OutData%StateRel_x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StateRel_x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%StateRel_x)>0) OutData%StateRel_x = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%StateRel_x))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%StateRel_x) - DEALLOCATE(mask2) + Int_BufSz = Int_BufSz + 1 ! OtherSt_HD allocated yes/no + IF ( ALLOCATED(InData%OtherSt_HD) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! OtherSt_HD upper/lower bounds for each dimension + DO i1 = LBOUND(InData%OtherSt_HD,1), UBOUND(InData%OtherSt_HD,1) + Int_BufSz = Int_BufSz + 3 ! OtherSt_HD: size of buffers for each call to pack subtype + CALL HydroDyn_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_HD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt_HD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! OtherSt_HD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OtherSt_HD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OtherSt_HD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StateRel_xdot not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%StateRel_xdot)) DEALLOCATE(OutData%StateRel_xdot) - ALLOCATE(OutData%StateRel_xdot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StateRel_xdot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%StateRel_xdot)>0) OutData%StateRel_xdot = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%StateRel_xdot))-1 ), mask2, 0.0_DbKi ), R8Ki) - Db_Xferred = Db_Xferred + SIZE(OutData%StateRel_xdot) - DEALLOCATE(mask2) + Int_BufSz = Int_BufSz + 1 ! u_HD allocated yes/no + IF ( ALLOCATED(InData%u_HD) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! u_HD upper/lower bounds for each dimension + DO i1 = LBOUND(InData%u_HD,1), UBOUND(InData%u_HD,1) + Int_BufSz = Int_BufSz + 3 ! u_HD: size of buffers for each call to pack subtype + CALL HydroDyn_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_HD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_HD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u_HD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u_HD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u_HD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IsLoad_u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%IsLoad_u)) DEALLOCATE(OutData%IsLoad_u) - ALLOCATE(OutData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%IsLoad_u)>0) OutData%IsLoad_u = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%IsLoad_u))-1 ), OutData%IsLoad_u), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%IsLoad_u) - DEALLOCATE(mask1) + Int_BufSz = Int_BufSz + 1 ! x_IceF allocated yes/no + IF ( ALLOCATED(InData%x_IceF) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! x_IceF upper/lower bounds for each dimension + DO i1 = LBOUND(InData%x_IceF,1), UBOUND(InData%x_IceF,1) + Int_BufSz = Int_BufSz + 3 ! x_IceF: size of buffers for each call to pack subtype + CALL IceFloe_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_IceF(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x_IceF + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! x_IceF + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! x_IceF + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! x_IceF + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RotFrame_u)) DEALLOCATE(OutData%RotFrame_u) - ALLOCATE(OutData%RotFrame_u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%RotFrame_u)>0) OutData%RotFrame_u = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%RotFrame_u))-1 ), OutData%RotFrame_u), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%RotFrame_u) - DEALLOCATE(mask1) + Int_BufSz = Int_BufSz + 1 ! xd_IceF allocated yes/no + IF ( ALLOCATED(InData%xd_IceF) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! xd_IceF upper/lower bounds for each dimension + DO i1 = LBOUND(InData%xd_IceF,1), UBOUND(InData%xd_IceF,1) + Int_BufSz = Int_BufSz + 3 ! xd_IceF: size of buffers for each call to pack subtype + CALL IceFloe_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_IceF(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd_IceF + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! xd_IceF + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! xd_IceF + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! xd_IceF + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO END IF - 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 - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%RotFrame_y)>0) OutData%RotFrame_y = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%RotFrame_y))-1 ), OutData%RotFrame_y), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%RotFrame_y) - DEALLOCATE(mask1) + Int_BufSz = Int_BufSz + 1 ! z_IceF allocated yes/no + IF ( ALLOCATED(InData%z_IceF) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! z_IceF upper/lower bounds for each dimension + DO i1 = LBOUND(InData%z_IceF,1), UBOUND(InData%z_IceF,1) + Int_BufSz = Int_BufSz + 3 ! z_IceF: size of buffers for each call to pack subtype + CALL IceFloe_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_IceF(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z_IceF + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! z_IceF + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! z_IceF + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! z_IceF + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO END IF - 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 - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%RotFrame_x)>0) OutData%RotFrame_x = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%RotFrame_x))-1 ), OutData%RotFrame_x), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%RotFrame_x) - DEALLOCATE(mask1) + Int_BufSz = Int_BufSz + 1 ! OtherSt_IceF allocated yes/no + IF ( ALLOCATED(InData%OtherSt_IceF) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! OtherSt_IceF upper/lower bounds for each dimension + DO i1 = LBOUND(InData%OtherSt_IceF,1), UBOUND(InData%OtherSt_IceF,1) + Int_BufSz = Int_BufSz + 3 ! OtherSt_IceF: size of buffers for each call to pack subtype + CALL IceFloe_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_IceF(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt_IceF + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! OtherSt_IceF + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OtherSt_IceF + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OtherSt_IceF + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_z not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%RotFrame_z)) DEALLOCATE(OutData%RotFrame_z) - ALLOCATE(OutData%RotFrame_z(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%RotFrame_z)>0) OutData%RotFrame_z = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%RotFrame_z))-1 ), OutData%RotFrame_z), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%RotFrame_z) - DEALLOCATE(mask1) + Int_BufSz = Int_BufSz + 1 ! u_IceF allocated yes/no + IF ( ALLOCATED(InData%u_IceF) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! u_IceF upper/lower bounds for each dimension + DO i1 = LBOUND(InData%u_IceF,1), UBOUND(InData%u_IceF,1) + Int_BufSz = Int_BufSz + 3 ! u_IceF: size of buffers for each call to pack subtype + CALL IceFloe_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_IceF(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_IceF + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u_IceF + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u_IceF + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u_IceF + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO END IF - 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 - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%DerivOrder_x)>0) OutData%DerivOrder_x = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%DerivOrder_x))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%DerivOrder_x) - DEALLOCATE(mask1) + Int_BufSz = Int_BufSz + 1 ! x_MAP allocated yes/no + IF ( ALLOCATED(InData%x_MAP) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! x_MAP upper/lower bounds for each dimension + DO i1 = LBOUND(InData%x_MAP,1), UBOUND(InData%x_MAP,1) + Int_BufSz = Int_BufSz + 3 ! x_MAP: size of buffers for each call to pack subtype + CALL MAP_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_MAP(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x_MAP + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! x_MAP + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! x_MAP + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! x_MAP + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO END IF - i1_l = LBOUND(OutData%SizeLin,1) - i1_u = UBOUND(OutData%SizeLin,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%SizeLin = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%SizeLin))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%SizeLin) - DEALLOCATE(mask1) - i1_l = LBOUND(OutData%LinStartIndx,1) - i1_u = UBOUND(OutData%LinStartIndx,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%LinStartIndx = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%LinStartIndx))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%LinStartIndx) - DEALLOCATE(mask1) - OutData%NumOutputs = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FAST_UnPackLinType + Int_BufSz = Int_BufSz + 1 ! xd_MAP allocated yes/no + IF ( ALLOCATED(InData%xd_MAP) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! xd_MAP upper/lower bounds for each dimension + DO i1 = LBOUND(InData%xd_MAP,1), UBOUND(InData%xd_MAP,1) + Int_BufSz = Int_BufSz + 3 ! xd_MAP: size of buffers for each call to pack subtype + CALL MAP_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_MAP(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd_MAP + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - SUBROUTINE FAST_CopyModLinType( SrcModLinTypeData, DstModLinTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_ModLinType), INTENT(IN) :: SrcModLinTypeData - TYPE(FAST_ModLinType), INTENT(INOUT) :: DstModLinTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyModLinType' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcModLinTypeData%Instance)) THEN - i1_l = LBOUND(SrcModLinTypeData%Instance,1) - i1_u = UBOUND(SrcModLinTypeData%Instance,1) - IF (.NOT. ALLOCATED(DstModLinTypeData%Instance)) THEN - ALLOCATE(DstModLinTypeData%Instance(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%Instance.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF + IF(ALLOCATED(Re_Buf)) THEN ! xd_MAP + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! xd_MAP + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! xd_MAP + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO END IF - DO i1 = LBOUND(SrcModLinTypeData%Instance,1), UBOUND(SrcModLinTypeData%Instance,1) - CALL FAST_Copylintype( SrcModLinTypeData%Instance(i1), DstModLinTypeData%Instance(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - END SUBROUTINE FAST_CopyModLinType + Int_BufSz = Int_BufSz + 1 ! z_MAP allocated yes/no + IF ( ALLOCATED(InData%z_MAP) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! z_MAP upper/lower bounds for each dimension + DO i1 = LBOUND(InData%z_MAP,1), UBOUND(InData%z_MAP,1) + Int_BufSz = Int_BufSz + 3 ! z_MAP: size of buffers for each call to pack subtype + CALL MAP_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_MAP(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z_MAP + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - SUBROUTINE FAST_DestroyModLinType( ModLinTypeData, ErrStat, ErrMsg ) - TYPE(FAST_ModLinType), INTENT(INOUT) :: ModLinTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyModLinType' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(ModLinTypeData%Instance)) THEN -DO i1 = LBOUND(ModLinTypeData%Instance,1), UBOUND(ModLinTypeData%Instance,1) - CALL FAST_Destroylintype( ModLinTypeData%Instance(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(ModLinTypeData%Instance) -ENDIF - END SUBROUTINE FAST_DestroyModLinType + IF(ALLOCATED(Re_Buf)) THEN ! z_MAP + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! z_MAP + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! z_MAP + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! u_MAP allocated yes/no + IF ( ALLOCATED(InData%u_MAP) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! u_MAP upper/lower bounds for each dimension + DO i1 = LBOUND(InData%u_MAP,1), UBOUND(InData%u_MAP,1) + Int_BufSz = Int_BufSz + 3 ! u_MAP: size of buffers for each call to pack subtype + CALL MAP_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_MAP(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_MAP + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - SUBROUTINE FAST_PackModLinType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FAST_ModLinType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackModLinType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + IF(ALLOCATED(Re_Buf)) THEN ! u_MAP + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u_MAP + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u_MAP + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! x_FEAM allocated yes/no + IF ( ALLOCATED(InData%x_FEAM) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! x_FEAM upper/lower bounds for each dimension + DO i1 = LBOUND(InData%x_FEAM,1), UBOUND(InData%x_FEAM,1) + Int_BufSz = Int_BufSz + 3 ! x_FEAM: size of buffers for each call to pack subtype + CALL FEAM_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_FEAM(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x_FEAM + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! Instance allocated yes/no - IF ( ALLOCATED(InData%Instance) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Instance upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%Instance,1), UBOUND(InData%Instance,1) - Int_BufSz = Int_BufSz + 3 ! Instance: size of buffers for each call to pack subtype - CALL FAST_Packlintype( Re_Buf, Db_Buf, Int_Buf, InData%Instance(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Instance + IF(ALLOCATED(Re_Buf)) THEN ! x_FEAM + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! x_FEAM + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! x_FEAM + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! xd_FEAM allocated yes/no + IF ( ALLOCATED(InData%xd_FEAM) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! xd_FEAM upper/lower bounds for each dimension + DO i1 = LBOUND(InData%xd_FEAM,1), UBOUND(InData%xd_FEAM,1) + Int_BufSz = Int_BufSz + 3 ! xd_FEAM: size of buffers for each call to pack subtype + CALL FEAM_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_FEAM(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd_FEAM CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! Instance + IF(ALLOCATED(Re_Buf)) THEN ! xd_FEAM Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! Instance + IF(ALLOCATED(Db_Buf)) THEN ! xd_FEAM Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! Instance + IF(ALLOCATED(Int_Buf)) THEN ! xd_FEAM + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! z_FEAM allocated yes/no + IF ( ALLOCATED(InData%z_FEAM) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! z_FEAM upper/lower bounds for each dimension + DO i1 = LBOUND(InData%z_FEAM,1), UBOUND(InData%z_FEAM,1) + Int_BufSz = Int_BufSz + 3 ! z_FEAM: size of buffers for each call to pack subtype + CALL FEAM_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_FEAM(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z_FEAM + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! z_FEAM + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! z_FEAM + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! z_FEAM + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! OtherSt_FEAM allocated yes/no + IF ( ALLOCATED(InData%OtherSt_FEAM) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! OtherSt_FEAM upper/lower bounds for each dimension + DO i1 = LBOUND(InData%OtherSt_FEAM,1), UBOUND(InData%OtherSt_FEAM,1) + Int_BufSz = Int_BufSz + 3 ! OtherSt_FEAM: size of buffers for each call to pack subtype + CALL FEAM_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_FEAM(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt_FEAM + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! OtherSt_FEAM + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OtherSt_FEAM + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OtherSt_FEAM + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! u_FEAM allocated yes/no + IF ( ALLOCATED(InData%u_FEAM) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! u_FEAM upper/lower bounds for each dimension + DO i1 = LBOUND(InData%u_FEAM,1), UBOUND(InData%u_FEAM,1) + Int_BufSz = Int_BufSz + 3 ! u_FEAM: size of buffers for each call to pack subtype + CALL FEAM_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_FEAM(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_FEAM + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u_FEAM + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u_FEAM + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u_FEAM + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! x_MD allocated yes/no + IF ( ALLOCATED(InData%x_MD) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! x_MD upper/lower bounds for each dimension + DO i1 = LBOUND(InData%x_MD,1), UBOUND(InData%x_MD,1) + Int_BufSz = Int_BufSz + 3 ! x_MD: size of buffers for each call to pack subtype + CALL MD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_MD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x_MD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! x_MD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! x_MD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! x_MD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! xd_MD allocated yes/no + IF ( ALLOCATED(InData%xd_MD) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! xd_MD upper/lower bounds for each dimension + DO i1 = LBOUND(InData%xd_MD,1), UBOUND(InData%xd_MD,1) + Int_BufSz = Int_BufSz + 3 ! xd_MD: size of buffers for each call to pack subtype + CALL MD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_MD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd_MD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! xd_MD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! xd_MD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! xd_MD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! z_MD allocated yes/no + IF ( ALLOCATED(InData%z_MD) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! z_MD upper/lower bounds for each dimension + DO i1 = LBOUND(InData%z_MD,1), UBOUND(InData%z_MD,1) + Int_BufSz = Int_BufSz + 3 ! z_MD: size of buffers for each call to pack subtype + CALL MD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_MD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z_MD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! z_MD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! z_MD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! z_MD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! OtherSt_MD allocated yes/no + IF ( ALLOCATED(InData%OtherSt_MD) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! OtherSt_MD upper/lower bounds for each dimension + DO i1 = LBOUND(InData%OtherSt_MD,1), UBOUND(InData%OtherSt_MD,1) + Int_BufSz = Int_BufSz + 3 ! OtherSt_MD: size of buffers for each call to pack subtype + CALL MD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_MD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt_MD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! OtherSt_MD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OtherSt_MD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OtherSt_MD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! u_MD allocated yes/no + IF ( ALLOCATED(InData%u_MD) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! u_MD upper/lower bounds for each dimension + DO i1 = LBOUND(InData%u_MD,1), UBOUND(InData%u_MD,1) + Int_BufSz = Int_BufSz + 3 ! u_MD: size of buffers for each call to pack subtype + CALL MD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_MD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u_MD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u_MD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u_MD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u_MD Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF @@ -3994,18 +5977,22 @@ SUBROUTINE FAST_PackModLinType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - IF ( .NOT. ALLOCATED(InData%Instance) ) THEN + IF ( .NOT. ALLOCATED(InData%x_IceD) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Instance,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Instance,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%x_IceD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_IceD,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%x_IceD,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_IceD,2) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%Instance,1), UBOUND(InData%Instance,1) - CALL FAST_Packlintype( Re_Buf, Db_Buf, Int_Buf, InData%Instance(i1), ErrStat2, ErrMsg2, OnlySize ) ! Instance + DO i2 = LBOUND(InData%x_IceD,2), UBOUND(InData%x_IceD,2) + DO i1 = LBOUND(InData%x_IceD,1), UBOUND(InData%x_IceD,1) + CALL IceD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_IceD(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! x_IceD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4034,245 +6021,208 @@ SUBROUTINE FAST_PackModLinType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF END DO + END DO END IF - END SUBROUTINE FAST_PackModLinType - - SUBROUTINE FAST_UnPackModLinType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FAST_ModLinType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackModLinType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Instance not allocated + IF ( .NOT. ALLOCATED(InData%xd_IceD) ) THEN + IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE + IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%xd_IceD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_IceD,1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Instance)) DEALLOCATE(OutData%Instance) - ALLOCATE(OutData%Instance(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Instance.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Instance,1), UBOUND(OutData%Instance,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FAST_Unpacklintype( Re_Buf, Db_Buf, Int_Buf, OutData%Instance(i1), ErrStat2, ErrMsg2 ) ! Instance + IntKiBuf( Int_Xferred ) = LBOUND(InData%xd_IceD,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_IceD,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%xd_IceD,2), UBOUND(InData%xd_IceD,2) + DO i1 = LBOUND(InData%xd_IceD,1), UBOUND(InData%xd_IceD,1) + CALL IceD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_IceD(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! xd_IceD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - END SUBROUTINE FAST_UnPackModLinType - - SUBROUTINE FAST_CopyLinFileType( SrcLinFileTypeData, DstLinFileTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_LinFileType), INTENT(IN) :: SrcLinFileTypeData - TYPE(FAST_LinFileType), INTENT(INOUT) :: DstLinFileTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyLinFileType' -! - ErrStat = ErrID_None - ErrMsg = "" - DO i1 = LBOUND(SrcLinFileTypeData%Modules,1), UBOUND(SrcLinFileTypeData%Modules,1) - CALL FAST_Copymodlintype( SrcLinFileTypeData%Modules(i1), DstLinFileTypeData%Modules(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL FAST_Copylintype( SrcLinFileTypeData%Glue, DstLinFileTypeData%Glue, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstLinFileTypeData%RotSpeed = SrcLinFileTypeData%RotSpeed - DstLinFileTypeData%Azimuth = SrcLinFileTypeData%Azimuth - END SUBROUTINE FAST_CopyLinFileType + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%z_IceD) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%z_IceD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_IceD,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%z_IceD,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_IceD,2) + Int_Xferred = Int_Xferred + 2 - SUBROUTINE FAST_DestroyLinFileType( LinFileTypeData, ErrStat, ErrMsg ) - TYPE(FAST_LinFileType), INTENT(INOUT) :: LinFileTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyLinFileType' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -DO i1 = LBOUND(LinFileTypeData%Modules,1), UBOUND(LinFileTypeData%Modules,1) - CALL FAST_Destroymodlintype( LinFileTypeData%Modules(i1), ErrStat, ErrMsg ) -ENDDO - CALL FAST_Destroylintype( LinFileTypeData%Glue, ErrStat, ErrMsg ) - END SUBROUTINE FAST_DestroyLinFileType + DO i2 = LBOUND(InData%z_IceD,2), UBOUND(InData%z_IceD,2) + DO i1 = LBOUND(InData%z_IceD,1), UBOUND(InData%z_IceD,1) + CALL IceD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_IceD(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! z_IceD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - SUBROUTINE FAST_PackLinFileType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FAST_LinFileType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackLinFileType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%OtherSt_IceD) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt_IceD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_IceD,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt_IceD,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_IceD,2) + Int_Xferred = Int_Xferred + 2 - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%Modules,1), UBOUND(InData%Modules,1) - Int_BufSz = Int_BufSz + 3 ! Modules: size of buffers for each call to pack subtype - CALL FAST_Packmodlintype( Re_Buf, Db_Buf, Int_Buf, InData%Modules(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Modules + DO i2 = LBOUND(InData%OtherSt_IceD,2), UBOUND(InData%OtherSt_IceD,2) + DO i1 = LBOUND(InData%OtherSt_IceD,1), UBOUND(InData%OtherSt_IceD,1) + CALL IceD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_IceD(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt_IceD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! Modules - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Modules - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Modules - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF END DO - Int_BufSz = Int_BufSz + 3 ! Glue: size of buffers for each call to pack subtype - CALL FAST_Packlintype( Re_Buf, Db_Buf, Int_Buf, InData%Glue, ErrStat2, ErrMsg2, .TRUE. ) ! Glue + END DO + END IF + IF ( .NOT. ALLOCATED(InData%u_IceD) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%u_IceD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_IceD,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%u_IceD,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_IceD,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%u_IceD,2), UBOUND(InData%u_IceD,2) + DO i1 = LBOUND(InData%u_IceD,1), UBOUND(InData%u_IceD,1) + CALL IceD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_IceD(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! u_IceD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! Glue - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Glue - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Glue - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Re_BufSz = Re_BufSz + 1 ! RotSpeed - Re_BufSz = Re_BufSz + 1 ! Azimuth - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END DO END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 + IF ( .NOT. ALLOCATED(InData%x_BD) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%x_BD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_BD,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%x_BD,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_BD,2) + Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%Modules,1), UBOUND(InData%Modules,1) - CALL FAST_Packmodlintype( Re_Buf, Db_Buf, Int_Buf, InData%Modules(i1), ErrStat2, ErrMsg2, OnlySize ) ! Modules + DO i2 = LBOUND(InData%x_BD,2), UBOUND(InData%x_BD,2) + DO i1 = LBOUND(InData%x_BD,1), UBOUND(InData%x_BD,1) + CALL BD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_BD(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! x_BD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4301,7 +6251,24 @@ SUBROUTINE FAST_PackLinFileType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF END DO - CALL FAST_Packlintype( Re_Buf, Db_Buf, Int_Buf, InData%Glue, ErrStat2, ErrMsg2, OnlySize ) ! Glue + END DO + END IF + IF ( .NOT. ALLOCATED(InData%xd_BD) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%xd_BD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_BD,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%xd_BD,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_BD,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%xd_BD,2), UBOUND(InData%xd_BD,2) + DO i1 = LBOUND(InData%xd_BD,1), UBOUND(InData%xd_BD,1) + CALL BD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_BD(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! xd_BD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4329,460 +6296,323 @@ SUBROUTINE FAST_PackLinFileType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RotSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Azimuth - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE FAST_PackLinFileType + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%z_BD) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%z_BD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_BD,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%z_BD,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_BD,2) + Int_Xferred = Int_Xferred + 2 - SUBROUTINE FAST_UnPackLinFileType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FAST_LinFileType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackLinFileType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - i1_l = LBOUND(OutData%Modules,1) - i1_u = UBOUND(OutData%Modules,1) - DO i1 = LBOUND(OutData%Modules,1), UBOUND(OutData%Modules,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FAST_Unpackmodlintype( Re_Buf, Db_Buf, Int_Buf, OutData%Modules(i1), ErrStat2, ErrMsg2 ) ! Modules + DO i2 = LBOUND(InData%z_BD,2), UBOUND(InData%z_BD,2) + DO i1 = LBOUND(InData%z_BD,1), UBOUND(InData%z_BD,1) + CALL BD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_BD(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! z_BD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF END DO - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FAST_Unpacklintype( Re_Buf, Db_Buf, Int_Buf, OutData%Glue, ErrStat2, ErrMsg2 ) ! Glue + END DO + END IF + IF ( .NOT. ALLOCATED(InData%OtherSt_BD) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt_BD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_BD,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt_BD,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_BD,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%OtherSt_BD,2), UBOUND(InData%OtherSt_BD,2) + DO i1 = LBOUND(InData%OtherSt_BD,1), UBOUND(InData%OtherSt_BD,1) + CALL BD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_BD(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt_BD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%RotSpeed = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Azimuth = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - END SUBROUTINE FAST_UnPackLinFileType + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%u_BD) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%u_BD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_BD,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%u_BD,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_BD,2) + Int_Xferred = Int_Xferred + 2 - SUBROUTINE FAST_CopyOutputFileType( SrcOutputFileTypeData, DstOutputFileTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_OutputFileType), INTENT(IN) :: SrcOutputFileTypeData - TYPE(FAST_OutputFileType), INTENT(INOUT) :: DstOutputFileTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyOutputFileType' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcOutputFileTypeData%TimeData)) THEN - i1_l = LBOUND(SrcOutputFileTypeData%TimeData,1) - i1_u = UBOUND(SrcOutputFileTypeData%TimeData,1) - IF (.NOT. ALLOCATED(DstOutputFileTypeData%TimeData)) THEN - ALLOCATE(DstOutputFileTypeData%TimeData(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputFileTypeData%TimeData.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF + DO i2 = LBOUND(InData%u_BD,2), UBOUND(InData%u_BD,2) + DO i1 = LBOUND(InData%u_BD,1), UBOUND(InData%u_BD,1) + CALL BD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_BD(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! u_BD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END DO END IF - DstOutputFileTypeData%TimeData = SrcOutputFileTypeData%TimeData -ENDIF -IF (ALLOCATED(SrcOutputFileTypeData%AllOutData)) THEN - i1_l = LBOUND(SrcOutputFileTypeData%AllOutData,1) - i1_u = UBOUND(SrcOutputFileTypeData%AllOutData,1) - i2_l = LBOUND(SrcOutputFileTypeData%AllOutData,2) - i2_u = UBOUND(SrcOutputFileTypeData%AllOutData,2) - IF (.NOT. ALLOCATED(DstOutputFileTypeData%AllOutData)) THEN - ALLOCATE(DstOutputFileTypeData%AllOutData(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputFileTypeData%AllOutData.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputFileTypeData%AllOutData = SrcOutputFileTypeData%AllOutData -ENDIF - DstOutputFileTypeData%n_Out = SrcOutputFileTypeData%n_Out - DstOutputFileTypeData%NOutSteps = SrcOutputFileTypeData%NOutSteps - DstOutputFileTypeData%numOuts = SrcOutputFileTypeData%numOuts - DstOutputFileTypeData%UnOu = SrcOutputFileTypeData%UnOu - DstOutputFileTypeData%UnSum = SrcOutputFileTypeData%UnSum - DstOutputFileTypeData%UnGra = SrcOutputFileTypeData%UnGra - DstOutputFileTypeData%FileDescLines = SrcOutputFileTypeData%FileDescLines -IF (ALLOCATED(SrcOutputFileTypeData%ChannelNames)) THEN - i1_l = LBOUND(SrcOutputFileTypeData%ChannelNames,1) - i1_u = UBOUND(SrcOutputFileTypeData%ChannelNames,1) - IF (.NOT. ALLOCATED(DstOutputFileTypeData%ChannelNames)) THEN - ALLOCATE(DstOutputFileTypeData%ChannelNames(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputFileTypeData%ChannelNames.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputFileTypeData%ChannelNames = SrcOutputFileTypeData%ChannelNames -ENDIF -IF (ALLOCATED(SrcOutputFileTypeData%ChannelUnits)) THEN - i1_l = LBOUND(SrcOutputFileTypeData%ChannelUnits,1) - i1_u = UBOUND(SrcOutputFileTypeData%ChannelUnits,1) - IF (.NOT. ALLOCATED(DstOutputFileTypeData%ChannelUnits)) THEN - ALLOCATE(DstOutputFileTypeData%ChannelUnits(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputFileTypeData%ChannelUnits.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstOutputFileTypeData%ChannelUnits = SrcOutputFileTypeData%ChannelUnits -ENDIF - DO i1 = LBOUND(SrcOutputFileTypeData%Module_Ver,1), UBOUND(SrcOutputFileTypeData%Module_Ver,1) - CALL NWTC_Library_Copyprogdesc( SrcOutputFileTypeData%Module_Ver(i1), DstOutputFileTypeData%Module_Ver(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DstOutputFileTypeData%Module_Abrev = SrcOutputFileTypeData%Module_Abrev - DstOutputFileTypeData%VTK_count = SrcOutputFileTypeData%VTK_count - DstOutputFileTypeData%VTK_LastWaveIndx = SrcOutputFileTypeData%VTK_LastWaveIndx - CALL FAST_Copylinfiletype( SrcOutputFileTypeData%Lin, DstOutputFileTypeData%Lin, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE FAST_CopyOutputFileType - - SUBROUTINE FAST_DestroyOutputFileType( OutputFileTypeData, ErrStat, ErrMsg ) - TYPE(FAST_OutputFileType), INTENT(INOUT) :: OutputFileTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyOutputFileType' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(OutputFileTypeData%TimeData)) THEN - DEALLOCATE(OutputFileTypeData%TimeData) -ENDIF -IF (ALLOCATED(OutputFileTypeData%AllOutData)) THEN - DEALLOCATE(OutputFileTypeData%AllOutData) -ENDIF -IF (ALLOCATED(OutputFileTypeData%ChannelNames)) THEN - DEALLOCATE(OutputFileTypeData%ChannelNames) -ENDIF -IF (ALLOCATED(OutputFileTypeData%ChannelUnits)) THEN - DEALLOCATE(OutputFileTypeData%ChannelUnits) -ENDIF -DO i1 = LBOUND(OutputFileTypeData%Module_Ver,1), UBOUND(OutputFileTypeData%Module_Ver,1) - CALL NWTC_Library_Destroyprogdesc( OutputFileTypeData%Module_Ver(i1), ErrStat, ErrMsg ) -ENDDO - CALL FAST_Destroylinfiletype( OutputFileTypeData%Lin, ErrStat, ErrMsg ) - END SUBROUTINE FAST_DestroyOutputFileType - - SUBROUTINE FAST_PackOutputFileType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FAST_OutputFileType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackOutputFileType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + IF ( .NOT. ALLOCATED(InData%x_ED) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%x_ED,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_ED,1) + Int_Xferred = Int_Xferred + 2 - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! TimeData allocated yes/no - IF ( ALLOCATED(InData%TimeData) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! TimeData upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%TimeData) ! TimeData - END IF - Int_BufSz = Int_BufSz + 1 ! AllOutData allocated yes/no - IF ( ALLOCATED(InData%AllOutData) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! AllOutData upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%AllOutData) ! AllOutData - END IF - Int_BufSz = Int_BufSz + 1 ! n_Out - Int_BufSz = Int_BufSz + 1 ! NOutSteps - Int_BufSz = Int_BufSz + SIZE(InData%numOuts) ! numOuts - Int_BufSz = Int_BufSz + 1 ! UnOu - Int_BufSz = Int_BufSz + 1 ! UnSum - Int_BufSz = Int_BufSz + 1 ! UnGra - Int_BufSz = Int_BufSz + SIZE(InData%FileDescLines)*LEN(InData%FileDescLines) ! FileDescLines - Int_BufSz = Int_BufSz + 1 ! ChannelNames allocated yes/no - IF ( ALLOCATED(InData%ChannelNames) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ChannelNames upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ChannelNames)*LEN(InData%ChannelNames) ! ChannelNames - END IF - Int_BufSz = Int_BufSz + 1 ! ChannelUnits allocated yes/no - IF ( ALLOCATED(InData%ChannelUnits) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ChannelUnits upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%ChannelUnits)*LEN(InData%ChannelUnits) ! ChannelUnits - END IF - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%Module_Ver,1), UBOUND(InData%Module_Ver,1) - Int_BufSz = Int_BufSz + 3 ! Module_Ver: size of buffers for each call to pack subtype - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Module_Ver(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Module_Ver + DO i1 = LBOUND(InData%x_ED,1), UBOUND(InData%x_ED,1) + CALL ED_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_ED(i1), ErrStat2, ErrMsg2, OnlySize ) ! x_ED CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! Module_Ver - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Module_Ver - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Module_Ver - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF END DO - Int_BufSz = Int_BufSz + SIZE(InData%Module_Abrev)*LEN(InData%Module_Abrev) ! Module_Abrev - Int_BufSz = Int_BufSz + 1 ! VTK_count - Int_BufSz = Int_BufSz + 1 ! VTK_LastWaveIndx - Int_BufSz = Int_BufSz + 3 ! Lin: size of buffers for each call to pack subtype - CALL FAST_Packlinfiletype( Re_Buf, Db_Buf, Int_Buf, InData%Lin, ErrStat2, ErrMsg2, .TRUE. ) ! Lin - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Lin - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Lin - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Lin - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%TimeData) ) THEN + IF ( .NOT. ALLOCATED(InData%xd_ED) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%TimeData,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TimeData,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%xd_ED,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_ED,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TimeData)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%TimeData))-1 ) = PACK(InData%TimeData,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%TimeData) + DO i1 = LBOUND(InData%xd_ED,1), UBOUND(InData%xd_ED,1) + CALL ED_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_ED(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd_ED + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO END IF - IF ( .NOT. ALLOCATED(InData%AllOutData) ) THEN + IF ( .NOT. ALLOCATED(InData%z_ED) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AllOutData,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AllOutData,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AllOutData,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AllOutData,2) + IntKiBuf( Int_Xferred ) = LBOUND(InData%z_ED,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_ED,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AllOutData)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AllOutData))-1 ) = PACK(InData%AllOutData,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AllOutData) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%n_Out - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NOutSteps - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%numOuts))-1 ) = PACK(InData%numOuts,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%numOuts) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UnOu - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UnSum - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UnGra - Int_Xferred = Int_Xferred + 1 - DO i1 = LBOUND(InData%FileDescLines,1), UBOUND(InData%FileDescLines,1) - DO I = 1, LEN(InData%FileDescLines) - IntKiBuf(Int_Xferred) = ICHAR(InData%FileDescLines(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - IF ( .NOT. ALLOCATED(InData%ChannelNames) ) THEN + DO i1 = LBOUND(InData%z_ED,1), UBOUND(InData%z_ED,1) + CALL ED_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_ED(i1), ErrStat2, ErrMsg2, OnlySize ) ! z_ED + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%OtherSt_ED) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ChannelNames,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ChannelNames,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt_ED,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_ED,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%ChannelNames,1), UBOUND(InData%ChannelNames,1) - DO I = 1, LEN(InData%ChannelNames) - IntKiBuf(Int_Xferred) = ICHAR(InData%ChannelNames(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 + DO i1 = LBOUND(InData%OtherSt_ED,1), UBOUND(InData%OtherSt_ED,1) + CALL ED_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_ED(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt_ED + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO END IF - IF ( .NOT. ALLOCATED(InData%ChannelUnits) ) THEN + IF ( .NOT. ALLOCATED(InData%u_ED) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ChannelUnits,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ChannelUnits,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%u_ED,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_ED,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%ChannelUnits,1), UBOUND(InData%ChannelUnits,1) - DO I = 1, LEN(InData%ChannelUnits) - IntKiBuf(Int_Xferred) = ICHAR(InData%ChannelUnits(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - END IF - DO i1 = LBOUND(InData%Module_Ver,1), UBOUND(InData%Module_Ver,1) - CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Module_Ver(i1), ErrStat2, ErrMsg2, OnlySize ) ! Module_Ver + DO i1 = LBOUND(InData%u_ED,1), UBOUND(InData%u_ED,1) + CALL ED_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_ED(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_ED CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4811,17 +6641,19 @@ SUBROUTINE FAST_PackOutputFileType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF END DO - DO i1 = LBOUND(InData%Module_Abrev,1), UBOUND(InData%Module_Abrev,1) - DO I = 1, LEN(InData%Module_Abrev) - IntKiBuf(Int_Xferred) = ICHAR(InData%Module_Abrev(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%VTK_count - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%VTK_LastWaveIndx - Int_Xferred = Int_Xferred + 1 - CALL FAST_Packlinfiletype( Re_Buf, Db_Buf, Int_Buf, InData%Lin, ErrStat2, ErrMsg2, OnlySize ) ! Lin + END IF + IF ( .NOT. ALLOCATED(InData%x_SrvD) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%x_SrvD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_SrvD,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%x_SrvD,1), UBOUND(InData%x_SrvD,1) + CALL SrvD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_SrvD(i1), ErrStat2, ErrMsg2, OnlySize ) ! x_SrvD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4849,861 +6681,471 @@ SUBROUTINE FAST_PackOutputFileType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - END SUBROUTINE FAST_PackOutputFileType - - SUBROUTINE FAST_UnPackOutputFileType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FAST_OutputFileType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackOutputFileType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TimeData not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%TimeData)) DEALLOCATE(OutData%TimeData) - ALLOCATE(OutData%TimeData(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TimeData.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TimeData)>0) OutData%TimeData = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%TimeData))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%TimeData) - DEALLOCATE(mask1) + END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AllOutData not allocated + IF ( .NOT. ALLOCATED(InData%xd_SrvD) ) THEN + IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE + IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( 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%xd_SrvD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_SrvD,1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AllOutData)) DEALLOCATE(OutData%AllOutData) - ALLOCATE(OutData%AllOutData(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOutData.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%AllOutData)>0) OutData%AllOutData = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AllOutData))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AllOutData) - DEALLOCATE(mask2) + + DO i1 = LBOUND(InData%xd_SrvD,1), UBOUND(InData%xd_SrvD,1) + CALL SrvD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_SrvD(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd_SrvD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO END IF - OutData%n_Out = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NOutSteps = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%numOuts,1) - i1_u = UBOUND(OutData%numOuts,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%numOuts = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%numOuts))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%numOuts) - DEALLOCATE(mask1) - OutData%UnOu = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%UnSum = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%UnGra = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%FileDescLines,1) - i1_u = UBOUND(OutData%FileDescLines,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%FileDescLines,1), UBOUND(OutData%FileDescLines,1) - DO I = 1, LEN(OutData%FileDescLines) - OutData%FileDescLines(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - DEALLOCATE(mask1) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ChannelNames not allocated + IF ( .NOT. ALLOCATED(InData%z_SrvD) ) THEN + IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE + IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%z_SrvD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_SrvD,1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ChannelNames)) DEALLOCATE(OutData%ChannelNames) - ALLOCATE(OutData%ChannelNames(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ChannelNames.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%ChannelNames,1), UBOUND(OutData%ChannelNames,1) - DO I = 1, LEN(OutData%ChannelNames) - OutData%ChannelNames(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - DEALLOCATE(mask1) + + DO i1 = LBOUND(InData%z_SrvD,1), UBOUND(InData%z_SrvD,1) + CALL SrvD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_SrvD(i1), ErrStat2, ErrMsg2, OnlySize ) ! z_SrvD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ChannelUnits not allocated + IF ( .NOT. ALLOCATED(InData%OtherSt_SrvD) ) THEN + IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE + IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt_SrvD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_SrvD,1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ChannelUnits)) DEALLOCATE(OutData%ChannelUnits) - ALLOCATE(OutData%ChannelUnits(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ChannelUnits.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%ChannelUnits,1), UBOUND(OutData%ChannelUnits,1) - DO I = 1, LEN(OutData%ChannelUnits) - OutData%ChannelUnits(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - DEALLOCATE(mask1) + + DO i1 = LBOUND(InData%OtherSt_SrvD,1), UBOUND(InData%OtherSt_SrvD,1) + CALL SrvD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_SrvD(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt_SrvD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO END IF - i1_l = LBOUND(OutData%Module_Ver,1) - i1_u = UBOUND(OutData%Module_Ver,1) - DO i1 = LBOUND(OutData%Module_Ver,1), UBOUND(OutData%Module_Ver,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackprogdesc( Re_Buf, Db_Buf, Int_Buf, OutData%Module_Ver(i1), ErrStat2, ErrMsg2 ) ! Module_Ver + IF ( .NOT. ALLOCATED(InData%u_SrvD) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%u_SrvD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_SrvD,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%u_SrvD,1), UBOUND(InData%u_SrvD,1) + CALL SrvD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_SrvD(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_SrvD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF END DO - i1_l = LBOUND(OutData%Module_Abrev,1) - i1_u = UBOUND(OutData%Module_Abrev,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%Module_Abrev,1), UBOUND(OutData%Module_Abrev,1) - DO I = 1, LEN(OutData%Module_Abrev) - OutData%Module_Abrev(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - END DO !i1 - DEALLOCATE(mask1) - OutData%VTK_count = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%VTK_LastWaveIndx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FAST_Unpacklinfiletype( Re_Buf, Db_Buf, Int_Buf, OutData%Lin, ErrStat2, ErrMsg2 ) ! Lin + END IF + IF ( .NOT. ALLOCATED(InData%x_AD) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%x_AD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_AD,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%x_AD,1), UBOUND(InData%x_AD,1) + CALL AD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_AD(i1), ErrStat2, ErrMsg2, OnlySize ) ! x_AD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE FAST_UnPackOutputFileType + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%xd_AD) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%xd_AD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_AD,1) + Int_Xferred = Int_Xferred + 2 - SUBROUTINE FAST_CopyIceDyn_Data( SrcIceDyn_DataData, DstIceDyn_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceDyn_Data), INTENT(INOUT) :: SrcIceDyn_DataData - TYPE(IceDyn_Data), INTENT(INOUT) :: DstIceDyn_DataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyIceDyn_Data' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcIceDyn_DataData%x)) THEN - i1_l = LBOUND(SrcIceDyn_DataData%x,1) - i1_u = UBOUND(SrcIceDyn_DataData%x,1) - i2_l = LBOUND(SrcIceDyn_DataData%x,2) - i2_u = UBOUND(SrcIceDyn_DataData%x,2) - IF (.NOT. ALLOCATED(DstIceDyn_DataData%x)) THEN - ALLOCATE(DstIceDyn_DataData%x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF + DO i1 = LBOUND(InData%xd_AD,1), UBOUND(InData%xd_AD,1) + CALL AD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_AD(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd_AD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO END IF - DO i2 = LBOUND(SrcIceDyn_DataData%x,2), UBOUND(SrcIceDyn_DataData%x,2) - DO i1 = LBOUND(SrcIceDyn_DataData%x,1), UBOUND(SrcIceDyn_DataData%x,1) - CALL IceD_CopyContState( SrcIceDyn_DataData%x(i1,i2), DstIceDyn_DataData%x(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcIceDyn_DataData%xd)) THEN - i1_l = LBOUND(SrcIceDyn_DataData%xd,1) - i1_u = UBOUND(SrcIceDyn_DataData%xd,1) - i2_l = LBOUND(SrcIceDyn_DataData%xd,2) - i2_u = UBOUND(SrcIceDyn_DataData%xd,2) - IF (.NOT. ALLOCATED(DstIceDyn_DataData%xd)) THEN - ALLOCATE(DstIceDyn_DataData%xd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%xd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF + IF ( .NOT. ALLOCATED(InData%z_AD) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%z_AD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_AD,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%z_AD,1), UBOUND(InData%z_AD,1) + CALL AD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_AD(i1), ErrStat2, ErrMsg2, OnlySize ) ! z_AD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO END IF - DO i2 = LBOUND(SrcIceDyn_DataData%xd,2), UBOUND(SrcIceDyn_DataData%xd,2) - DO i1 = LBOUND(SrcIceDyn_DataData%xd,1), UBOUND(SrcIceDyn_DataData%xd,1) - CALL IceD_CopyDiscState( SrcIceDyn_DataData%xd(i1,i2), DstIceDyn_DataData%xd(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcIceDyn_DataData%z)) THEN - i1_l = LBOUND(SrcIceDyn_DataData%z,1) - i1_u = UBOUND(SrcIceDyn_DataData%z,1) - i2_l = LBOUND(SrcIceDyn_DataData%z,2) - i2_u = UBOUND(SrcIceDyn_DataData%z,2) - IF (.NOT. ALLOCATED(DstIceDyn_DataData%z)) THEN - ALLOCATE(DstIceDyn_DataData%z(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF + IF ( .NOT. ALLOCATED(InData%OtherSt_AD) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt_AD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_AD,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%OtherSt_AD,1), UBOUND(InData%OtherSt_AD,1) + CALL AD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_AD(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt_AD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO END IF - DO i2 = LBOUND(SrcIceDyn_DataData%z,2), UBOUND(SrcIceDyn_DataData%z,2) - DO i1 = LBOUND(SrcIceDyn_DataData%z,1), UBOUND(SrcIceDyn_DataData%z,1) - CALL IceD_CopyConstrState( SrcIceDyn_DataData%z(i1,i2), DstIceDyn_DataData%z(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcIceDyn_DataData%OtherSt)) THEN - i1_l = LBOUND(SrcIceDyn_DataData%OtherSt,1) - i1_u = UBOUND(SrcIceDyn_DataData%OtherSt,1) - i2_l = LBOUND(SrcIceDyn_DataData%OtherSt,2) - i2_u = UBOUND(SrcIceDyn_DataData%OtherSt,2) - IF (.NOT. ALLOCATED(DstIceDyn_DataData%OtherSt)) THEN - ALLOCATE(DstIceDyn_DataData%OtherSt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%OtherSt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF + IF ( .NOT. ALLOCATED(InData%u_AD) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%u_AD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_AD,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%u_AD,1), UBOUND(InData%u_AD,1) + CALL AD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_AD(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_AD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO END IF - DO i2 = LBOUND(SrcIceDyn_DataData%OtherSt,2), UBOUND(SrcIceDyn_DataData%OtherSt,2) - DO i1 = LBOUND(SrcIceDyn_DataData%OtherSt,1), UBOUND(SrcIceDyn_DataData%OtherSt,1) - CALL IceD_CopyOtherState( SrcIceDyn_DataData%OtherSt(i1,i2), DstIceDyn_DataData%OtherSt(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcIceDyn_DataData%p)) THEN - i1_l = LBOUND(SrcIceDyn_DataData%p,1) - i1_u = UBOUND(SrcIceDyn_DataData%p,1) - IF (.NOT. ALLOCATED(DstIceDyn_DataData%p)) THEN - ALLOCATE(DstIceDyn_DataData%p(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%p.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF + IF ( .NOT. ALLOCATED(InData%x_IfW) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%x_IfW,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_IfW,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%x_IfW,1), UBOUND(InData%x_IfW,1) + CALL InflowWind_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_IfW(i1), ErrStat2, ErrMsg2, OnlySize ) ! x_IfW + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO END IF - DO i1 = LBOUND(SrcIceDyn_DataData%p,1), UBOUND(SrcIceDyn_DataData%p,1) - CALL IceD_CopyParam( SrcIceDyn_DataData%p(i1), DstIceDyn_DataData%p(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcIceDyn_DataData%u)) THEN - i1_l = LBOUND(SrcIceDyn_DataData%u,1) - i1_u = UBOUND(SrcIceDyn_DataData%u,1) - IF (.NOT. ALLOCATED(DstIceDyn_DataData%u)) THEN - ALLOCATE(DstIceDyn_DataData%u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF + IF ( .NOT. ALLOCATED(InData%xd_IfW) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%xd_IfW,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_IfW,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%xd_IfW,1), UBOUND(InData%xd_IfW,1) + CALL InflowWind_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_IfW(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd_IfW + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO END IF - DO i1 = LBOUND(SrcIceDyn_DataData%u,1), UBOUND(SrcIceDyn_DataData%u,1) - CALL IceD_CopyInput( SrcIceDyn_DataData%u(i1), DstIceDyn_DataData%u(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcIceDyn_DataData%y)) THEN - i1_l = LBOUND(SrcIceDyn_DataData%y,1) - i1_u = UBOUND(SrcIceDyn_DataData%y,1) - IF (.NOT. ALLOCATED(DstIceDyn_DataData%y)) THEN - ALLOCATE(DstIceDyn_DataData%y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcIceDyn_DataData%y,1), UBOUND(SrcIceDyn_DataData%y,1) - CALL IceD_CopyOutput( SrcIceDyn_DataData%y(i1), DstIceDyn_DataData%y(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcIceDyn_DataData%m)) THEN - i1_l = LBOUND(SrcIceDyn_DataData%m,1) - i1_u = UBOUND(SrcIceDyn_DataData%m,1) - IF (.NOT. ALLOCATED(DstIceDyn_DataData%m)) THEN - ALLOCATE(DstIceDyn_DataData%m(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%m.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcIceDyn_DataData%m,1), UBOUND(SrcIceDyn_DataData%m,1) - CALL IceD_CopyMisc( SrcIceDyn_DataData%m(i1), DstIceDyn_DataData%m(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcIceDyn_DataData%Input)) THEN - i1_l = LBOUND(SrcIceDyn_DataData%Input,1) - i1_u = UBOUND(SrcIceDyn_DataData%Input,1) - i2_l = LBOUND(SrcIceDyn_DataData%Input,2) - i2_u = UBOUND(SrcIceDyn_DataData%Input,2) - IF (.NOT. ALLOCATED(DstIceDyn_DataData%Input)) THEN - ALLOCATE(DstIceDyn_DataData%Input(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcIceDyn_DataData%Input,2), UBOUND(SrcIceDyn_DataData%Input,2) - DO i1 = LBOUND(SrcIceDyn_DataData%Input,1), UBOUND(SrcIceDyn_DataData%Input,1) - CALL IceD_CopyInput( SrcIceDyn_DataData%Input(i1,i2), DstIceDyn_DataData%Input(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcIceDyn_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcIceDyn_DataData%InputTimes,1) - i1_u = UBOUND(SrcIceDyn_DataData%InputTimes,1) - i2_l = LBOUND(SrcIceDyn_DataData%InputTimes,2) - i2_u = UBOUND(SrcIceDyn_DataData%InputTimes,2) - IF (.NOT. ALLOCATED(DstIceDyn_DataData%InputTimes)) THEN - ALLOCATE(DstIceDyn_DataData%InputTimes(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstIceDyn_DataData%InputTimes = SrcIceDyn_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyIceDyn_Data - - SUBROUTINE FAST_DestroyIceDyn_Data( IceDyn_DataData, ErrStat, ErrMsg ) - TYPE(IceDyn_Data), INTENT(INOUT) :: IceDyn_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyIceDyn_Data' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(IceDyn_DataData%x)) THEN -DO i2 = LBOUND(IceDyn_DataData%x,2), UBOUND(IceDyn_DataData%x,2) -DO i1 = LBOUND(IceDyn_DataData%x,1), UBOUND(IceDyn_DataData%x,1) - CALL IceD_DestroyContState( IceDyn_DataData%x(i1,i2), ErrStat, ErrMsg ) -ENDDO -ENDDO - DEALLOCATE(IceDyn_DataData%x) -ENDIF -IF (ALLOCATED(IceDyn_DataData%xd)) THEN -DO i2 = LBOUND(IceDyn_DataData%xd,2), UBOUND(IceDyn_DataData%xd,2) -DO i1 = LBOUND(IceDyn_DataData%xd,1), UBOUND(IceDyn_DataData%xd,1) - CALL IceD_DestroyDiscState( IceDyn_DataData%xd(i1,i2), ErrStat, ErrMsg ) -ENDDO -ENDDO - DEALLOCATE(IceDyn_DataData%xd) -ENDIF -IF (ALLOCATED(IceDyn_DataData%z)) THEN -DO i2 = LBOUND(IceDyn_DataData%z,2), UBOUND(IceDyn_DataData%z,2) -DO i1 = LBOUND(IceDyn_DataData%z,1), UBOUND(IceDyn_DataData%z,1) - CALL IceD_DestroyConstrState( IceDyn_DataData%z(i1,i2), ErrStat, ErrMsg ) -ENDDO -ENDDO - DEALLOCATE(IceDyn_DataData%z) -ENDIF -IF (ALLOCATED(IceDyn_DataData%OtherSt)) THEN -DO i2 = LBOUND(IceDyn_DataData%OtherSt,2), UBOUND(IceDyn_DataData%OtherSt,2) -DO i1 = LBOUND(IceDyn_DataData%OtherSt,1), UBOUND(IceDyn_DataData%OtherSt,1) - CALL IceD_DestroyOtherState( IceDyn_DataData%OtherSt(i1,i2), ErrStat, ErrMsg ) -ENDDO -ENDDO - DEALLOCATE(IceDyn_DataData%OtherSt) -ENDIF -IF (ALLOCATED(IceDyn_DataData%p)) THEN -DO i1 = LBOUND(IceDyn_DataData%p,1), UBOUND(IceDyn_DataData%p,1) - CALL IceD_DestroyParam( IceDyn_DataData%p(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(IceDyn_DataData%p) -ENDIF -IF (ALLOCATED(IceDyn_DataData%u)) THEN -DO i1 = LBOUND(IceDyn_DataData%u,1), UBOUND(IceDyn_DataData%u,1) - CALL IceD_DestroyInput( IceDyn_DataData%u(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(IceDyn_DataData%u) -ENDIF -IF (ALLOCATED(IceDyn_DataData%y)) THEN -DO i1 = LBOUND(IceDyn_DataData%y,1), UBOUND(IceDyn_DataData%y,1) - CALL IceD_DestroyOutput( IceDyn_DataData%y(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(IceDyn_DataData%y) -ENDIF -IF (ALLOCATED(IceDyn_DataData%m)) THEN -DO i1 = LBOUND(IceDyn_DataData%m,1), UBOUND(IceDyn_DataData%m,1) - CALL IceD_DestroyMisc( IceDyn_DataData%m(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(IceDyn_DataData%m) -ENDIF -IF (ALLOCATED(IceDyn_DataData%Input)) THEN -DO i2 = LBOUND(IceDyn_DataData%Input,2), UBOUND(IceDyn_DataData%Input,2) -DO i1 = LBOUND(IceDyn_DataData%Input,1), UBOUND(IceDyn_DataData%Input,1) - CALL IceD_DestroyInput( IceDyn_DataData%Input(i1,i2), ErrStat, ErrMsg ) -ENDDO -ENDDO - DEALLOCATE(IceDyn_DataData%Input) -ENDIF -IF (ALLOCATED(IceDyn_DataData%InputTimes)) THEN - DEALLOCATE(IceDyn_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroyIceDyn_Data - - SUBROUTINE FAST_PackIceDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(IceDyn_Data), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackIceDyn_Data' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! x allocated yes/no - IF ( ALLOCATED(InData%x) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! x upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i2 = LBOUND(InData%x,2), UBOUND(InData%x,2) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL IceD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! xd allocated yes/no - IF ( ALLOCATED(InData%xd) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! xd upper/lower bounds for each dimension - DO i2 = LBOUND(InData%xd,2), UBOUND(InData%xd,2) - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL IceD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! z allocated yes/no - IF ( ALLOCATED(InData%z) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! z upper/lower bounds for each dimension - DO i2 = LBOUND(InData%z,2), UBOUND(InData%z,2) - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL IceD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! OtherSt allocated yes/no - IF ( ALLOCATED(InData%OtherSt) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! OtherSt upper/lower bounds for each dimension - DO i2 = LBOUND(InData%OtherSt,2), UBOUND(InData%OtherSt,2) - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL IceD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! p allocated yes/no - IF ( ALLOCATED(InData%p) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! p upper/lower bounds for each dimension - DO i1 = LBOUND(InData%p,1), UBOUND(InData%p,1) - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL IceD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p(i1), ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! u allocated yes/no - IF ( ALLOCATED(InData%u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u upper/lower bounds for each dimension - DO i1 = LBOUND(InData%u,1), UBOUND(InData%u,1) - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL IceD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! y allocated yes/no - IF ( ALLOCATED(InData%y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! y upper/lower bounds for each dimension - DO i1 = LBOUND(InData%y,1), UBOUND(InData%y,1) - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL IceD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y(i1), ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! m allocated yes/no - IF ( ALLOCATED(InData%m) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! m upper/lower bounds for each dimension - DO i1 = LBOUND(InData%m,1), UBOUND(InData%m,1) - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL IceD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m(i1), ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Input upper/lower bounds for each dimension - DO i2 = LBOUND(InData%Input,2), UBOUND(InData%Input,2) - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL IceD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Input - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no - IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! InputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%x) ) THEN + IF ( .NOT. ALLOCATED(InData%z_IfW) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%x,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x,2) + IntKiBuf( Int_Xferred ) = LBOUND(InData%z_IfW,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_IfW,1) Int_Xferred = Int_Xferred + 2 - DO i2 = LBOUND(InData%x,2), UBOUND(InData%x,2) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL IceD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! x + DO i1 = LBOUND(InData%z_IfW,1), UBOUND(InData%z_IfW,1) + CALL InflowWind_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_IfW(i1), ErrStat2, ErrMsg2, OnlySize ) ! z_IfW CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -5732,24 +7174,19 @@ SUBROUTINE FAST_PackIceDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF END DO - END DO END IF - IF ( .NOT. ALLOCATED(InData%xd) ) THEN + IF ( .NOT. ALLOCATED(InData%OtherSt_IfW) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xd,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd,2) + IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt_IfW,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_IfW,1) Int_Xferred = Int_Xferred + 2 - DO i2 = LBOUND(InData%xd,2), UBOUND(InData%xd,2) - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL IceD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! xd + DO i1 = LBOUND(InData%OtherSt_IfW,1), UBOUND(InData%OtherSt_IfW,1) + CALL InflowWind_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_IfW(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt_IfW CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -5778,24 +7215,19 @@ SUBROUTINE FAST_PackIceDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF END DO - END DO END IF - IF ( .NOT. ALLOCATED(InData%z) ) THEN + IF ( .NOT. ALLOCATED(InData%u_IfW) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%z,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%z,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z,2) + IntKiBuf( Int_Xferred ) = LBOUND(InData%u_IfW,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_IfW,1) Int_Xferred = Int_Xferred + 2 - DO i2 = LBOUND(InData%z,2), UBOUND(InData%z,2) - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL IceD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! z + DO i1 = LBOUND(InData%u_IfW,1), UBOUND(InData%u_IfW,1) + CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_IfW(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_IfW CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -5824,24 +7256,19 @@ SUBROUTINE FAST_PackIceDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF END DO - END DO END IF - IF ( .NOT. ALLOCATED(InData%OtherSt) ) THEN + IF ( .NOT. ALLOCATED(InData%x_SD) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt,2) + IntKiBuf( Int_Xferred ) = LBOUND(InData%x_SD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_SD,1) Int_Xferred = Int_Xferred + 2 - DO i2 = LBOUND(InData%OtherSt,2), UBOUND(InData%OtherSt,2) - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL IceD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt + DO i1 = LBOUND(InData%x_SD,1), UBOUND(InData%x_SD,1) + CALL SD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_SD(i1), ErrStat2, ErrMsg2, OnlySize ) ! x_SD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -5870,20 +7297,19 @@ SUBROUTINE FAST_PackIceDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF END DO - END DO END IF - IF ( .NOT. ALLOCATED(InData%p) ) THEN + IF ( .NOT. ALLOCATED(InData%xd_SD) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%p,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%p,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%xd_SD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_SD,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%p,1), UBOUND(InData%p,1) - CALL IceD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p(i1), ErrStat2, ErrMsg2, OnlySize ) ! p + DO i1 = LBOUND(InData%xd_SD,1), UBOUND(InData%xd_SD,1) + CALL SD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_SD(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd_SD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -5913,18 +7339,18 @@ SUBROUTINE FAST_PackIceDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er ENDIF END DO END IF - IF ( .NOT. ALLOCATED(InData%u) ) THEN + IF ( .NOT. ALLOCATED(InData%z_SD) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%z_SD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_SD,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%u,1), UBOUND(InData%u,1) - CALL IceD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u(i1), ErrStat2, ErrMsg2, OnlySize ) ! u + DO i1 = LBOUND(InData%z_SD,1), UBOUND(InData%z_SD,1) + CALL SD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_SD(i1), ErrStat2, ErrMsg2, OnlySize ) ! z_SD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -5954,18 +7380,18 @@ SUBROUTINE FAST_PackIceDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er ENDIF END DO END IF - IF ( .NOT. ALLOCATED(InData%y) ) THEN + IF ( .NOT. ALLOCATED(InData%OtherSt_SD) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt_SD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_SD,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%y,1), UBOUND(InData%y,1) - CALL IceD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y(i1), ErrStat2, ErrMsg2, OnlySize ) ! y + DO i1 = LBOUND(InData%OtherSt_SD,1), UBOUND(InData%OtherSt_SD,1) + CALL SD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_SD(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt_SD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -5995,18 +7421,18 @@ SUBROUTINE FAST_PackIceDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er ENDIF END DO END IF - IF ( .NOT. ALLOCATED(InData%m) ) THEN + IF ( .NOT. ALLOCATED(InData%u_SD) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%m,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%m,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%u_SD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_SD,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%m,1), UBOUND(InData%m,1) - CALL IceD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m(i1), ErrStat2, ErrMsg2, OnlySize ) ! m + DO i1 = LBOUND(InData%u_SD,1), UBOUND(InData%u_SD,1) + CALL SD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_SD(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_SD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6036,22 +7462,18 @@ SUBROUTINE FAST_PackIceDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er ENDIF END DO END IF - IF ( .NOT. ALLOCATED(InData%Input) ) THEN + IF ( .NOT. ALLOCATED(InData%x_ExtPtfm) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,2) + IntKiBuf( Int_Xferred ) = LBOUND(InData%x_ExtPtfm,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_ExtPtfm,1) Int_Xferred = Int_Xferred + 2 - DO i2 = LBOUND(InData%Input,2), UBOUND(InData%Input,2) - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL IceD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! Input + DO i1 = LBOUND(InData%x_ExtPtfm,1), UBOUND(InData%x_ExtPtfm,1) + CALL ExtPtfm_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_ExtPtfm(i1), ErrStat2, ErrMsg2, OnlySize ) ! x_ExtPtfm CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6080,1192 +7502,634 @@ SUBROUTINE FAST_PackIceDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF END DO - END DO END IF - IF ( .NOT. ALLOCATED(InData%InputTimes) ) THEN + IF ( .NOT. ALLOCATED(InData%xd_ExtPtfm) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,2) + IntKiBuf( Int_Xferred ) = LBOUND(InData%xd_ExtPtfm,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_ExtPtfm,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%InputTimes)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%InputTimes))-1 ) = PACK(InData%InputTimes,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%InputTimes) - END IF - END SUBROUTINE FAST_PackIceDyn_Data - - SUBROUTINE FAST_UnPackIceDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(IceDyn_Data), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackIceDyn_Data' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%x)) DEALLOCATE(OutData%x) - ALLOCATE(OutData%x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%x,2), UBOUND(OutData%x,2) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL IceD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1,i2), ErrStat2, ErrMsg2 ) ! x + DO i1 = LBOUND(InData%xd_ExtPtfm,1), UBOUND(InData%xd_ExtPtfm,1) + CALL ExtPtfm_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_ExtPtfm(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd_ExtPtfm CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xd not allocated + IF ( .NOT. ALLOCATED(InData%z_ExtPtfm) ) THEN + IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE + IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( 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%z_ExtPtfm,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_ExtPtfm,1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%xd)) DEALLOCATE(OutData%xd) - ALLOCATE(OutData%xd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%xd,2), UBOUND(OutData%xd,2) - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL IceD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1,i2), ErrStat2, ErrMsg2 ) ! xd + + DO i1 = LBOUND(InData%z_ExtPtfm,1), UBOUND(InData%z_ExtPtfm,1) + CALL ExtPtfm_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_ExtPtfm(i1), ErrStat2, ErrMsg2, OnlySize ) ! z_ExtPtfm CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z not allocated + IF ( .NOT. ALLOCATED(InData%OtherSt_ExtPtfm) ) THEN + IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE + IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( 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%OtherSt_ExtPtfm,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_ExtPtfm,1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%z)) DEALLOCATE(OutData%z) - ALLOCATE(OutData%z(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%z,2), UBOUND(OutData%z,2) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL IceD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1,i2), ErrStat2, ErrMsg2 ) ! z + + DO i1 = LBOUND(InData%OtherSt_ExtPtfm,1), UBOUND(InData%OtherSt_ExtPtfm,1) + CALL ExtPtfm_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_ExtPtfm(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt_ExtPtfm CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OtherSt not allocated + IF ( .NOT. ALLOCATED(InData%u_ExtPtfm) ) THEN + IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE + IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( 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%u_ExtPtfm,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_ExtPtfm,1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OtherSt)) DEALLOCATE(OutData%OtherSt) - ALLOCATE(OutData%OtherSt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%OtherSt,2), UBOUND(OutData%OtherSt,2) - DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL IceD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1,i2), ErrStat2, ErrMsg2 ) ! OtherSt + + DO i1 = LBOUND(InData%u_ExtPtfm,1), UBOUND(InData%u_ExtPtfm,1) + CALL ExtPtfm_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_ExtPtfm(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_ExtPtfm CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! p not allocated + IF ( .NOT. ALLOCATED(InData%x_HD) ) THEN + IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE + IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%x_HD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_HD,1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%p)) DEALLOCATE(OutData%p) - ALLOCATE(OutData%p(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%p.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%p,1), UBOUND(OutData%p,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL IceD_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p(i1), ErrStat2, ErrMsg2 ) ! p + + DO i1 = LBOUND(InData%x_HD,1), UBOUND(InData%x_HD,1) + CALL HydroDyn_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_HD(i1), ErrStat2, ErrMsg2, OnlySize ) ! x_HD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u not allocated + IF ( .NOT. ALLOCATED(InData%xd_HD) ) THEN + IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE + IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%xd_HD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_HD,1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%u)) DEALLOCATE(OutData%u) - ALLOCATE(OutData%u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%u,1), UBOUND(OutData%u,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL IceD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u(i1), ErrStat2, ErrMsg2 ) ! u + + DO i1 = LBOUND(InData%xd_HD,1), UBOUND(InData%xd_HD,1) + CALL HydroDyn_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_HD(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd_HD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! y not allocated + IF ( .NOT. ALLOCATED(InData%z_HD) ) THEN + IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE + IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%z_HD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_HD,1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%y)) DEALLOCATE(OutData%y) - ALLOCATE(OutData%y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%y,1), UBOUND(OutData%y,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL IceD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y(i1), ErrStat2, ErrMsg2 ) ! y + + DO i1 = LBOUND(InData%z_HD,1), UBOUND(InData%z_HD,1) + CALL HydroDyn_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_HD(i1), ErrStat2, ErrMsg2, OnlySize ) ! z_HD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! m not allocated + IF ( .NOT. ALLOCATED(InData%OtherSt_HD) ) THEN + IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE + IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt_HD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_HD,1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%m)) DEALLOCATE(OutData%m) - ALLOCATE(OutData%m(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%m.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%m,1), UBOUND(OutData%m,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL IceD_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m(i1), ErrStat2, ErrMsg2 ) ! m + + DO i1 = LBOUND(InData%OtherSt_HD,1), UBOUND(InData%OtherSt_HD,1) + CALL HydroDyn_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_HD(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt_HD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input not allocated + IF ( .NOT. ALLOCATED(InData%u_HD) ) THEN + IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE + IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%u_HD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_HD,1) Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i2 = LBOUND(OutData%Input,2), UBOUND(OutData%Input,2) - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL IceD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1,i2), ErrStat2, ErrMsg2 ) ! Input + + DO i1 = LBOUND(InData%u_HD,1), UBOUND(InData%u_HD,1) + CALL HydroDyn_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_HD(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_HD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF END DO + END IF + IF ( .NOT. ALLOCATED(InData%x_IceF) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%x_IceF,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_IceF,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%x_IceF,1), UBOUND(InData%x_IceF,1) + CALL IceFloe_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_IceF(i1), ErrStat2, ErrMsg2, OnlySize ) ! x_IceF + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes not allocated + IF ( .NOT. ALLOCATED(InData%xd_IceF) ) THEN + IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE + IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%xd_IceF,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_IceF,1) Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) + + DO i1 = LBOUND(InData%xd_IceF,1), UBOUND(InData%xd_IceF,1) + CALL IceFloe_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_IceF(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd_IceF + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%z_IceF) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%z_IceF,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_IceF,1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%InputTimes)>0) OutData%InputTimes = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%InputTimes))-1 ), mask2, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%InputTimes) - DEALLOCATE(mask2) + + DO i1 = LBOUND(InData%z_IceF,1), UBOUND(InData%z_IceF,1) + CALL IceFloe_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_IceF(i1), ErrStat2, ErrMsg2, OnlySize ) ! z_IceF + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO END IF - END SUBROUTINE FAST_UnPackIceDyn_Data + IF ( .NOT. ALLOCATED(InData%OtherSt_IceF) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt_IceF,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_IceF,1) + Int_Xferred = Int_Xferred + 2 - SUBROUTINE FAST_CopyBeamDyn_Data( SrcBeamDyn_DataData, DstBeamDyn_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(BeamDyn_Data), INTENT(INOUT) :: SrcBeamDyn_DataData - TYPE(BeamDyn_Data), INTENT(INOUT) :: DstBeamDyn_DataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyBeamDyn_Data' -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(SrcBeamDyn_DataData%x)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%x,1) - i1_u = UBOUND(SrcBeamDyn_DataData%x,1) - i2_l = LBOUND(SrcBeamDyn_DataData%x,2) - i2_u = UBOUND(SrcBeamDyn_DataData%x,2) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%x)) THEN - ALLOCATE(DstBeamDyn_DataData%x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%x.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF + DO i1 = LBOUND(InData%OtherSt_IceF,1), UBOUND(InData%OtherSt_IceF,1) + CALL IceFloe_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_IceF(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt_IceF + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO END IF - DO i2 = LBOUND(SrcBeamDyn_DataData%x,2), UBOUND(SrcBeamDyn_DataData%x,2) - DO i1 = LBOUND(SrcBeamDyn_DataData%x,1), UBOUND(SrcBeamDyn_DataData%x,1) - CALL BD_CopyContState( SrcBeamDyn_DataData%x(i1,i2), DstBeamDyn_DataData%x(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcBeamDyn_DataData%xd)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%xd,1) - i1_u = UBOUND(SrcBeamDyn_DataData%xd,1) - i2_l = LBOUND(SrcBeamDyn_DataData%xd,2) - i2_u = UBOUND(SrcBeamDyn_DataData%xd,2) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%xd)) THEN - ALLOCATE(DstBeamDyn_DataData%xd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%xd.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF + IF ( .NOT. ALLOCATED(InData%u_IceF) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%u_IceF,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_IceF,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%u_IceF,1), UBOUND(InData%u_IceF,1) + CALL IceFloe_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_IceF(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_IceF + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO END IF - DO i2 = LBOUND(SrcBeamDyn_DataData%xd,2), UBOUND(SrcBeamDyn_DataData%xd,2) - DO i1 = LBOUND(SrcBeamDyn_DataData%xd,1), UBOUND(SrcBeamDyn_DataData%xd,1) - CALL BD_CopyDiscState( SrcBeamDyn_DataData%xd(i1,i2), DstBeamDyn_DataData%xd(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcBeamDyn_DataData%z)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%z,1) - i1_u = UBOUND(SrcBeamDyn_DataData%z,1) - i2_l = LBOUND(SrcBeamDyn_DataData%z,2) - i2_u = UBOUND(SrcBeamDyn_DataData%z,2) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%z)) THEN - ALLOCATE(DstBeamDyn_DataData%z(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%z.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF + IF ( .NOT. ALLOCATED(InData%x_MAP) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%x_MAP,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_MAP,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%x_MAP,1), UBOUND(InData%x_MAP,1) + CALL MAP_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_MAP(i1), ErrStat2, ErrMsg2, OnlySize ) ! x_MAP + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO END IF - DO i2 = LBOUND(SrcBeamDyn_DataData%z,2), UBOUND(SrcBeamDyn_DataData%z,2) - DO i1 = LBOUND(SrcBeamDyn_DataData%z,1), UBOUND(SrcBeamDyn_DataData%z,1) - CALL BD_CopyConstrState( SrcBeamDyn_DataData%z(i1,i2), DstBeamDyn_DataData%z(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcBeamDyn_DataData%OtherSt)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%OtherSt,1) - i1_u = UBOUND(SrcBeamDyn_DataData%OtherSt,1) - i2_l = LBOUND(SrcBeamDyn_DataData%OtherSt,2) - i2_u = UBOUND(SrcBeamDyn_DataData%OtherSt,2) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%OtherSt)) THEN - ALLOCATE(DstBeamDyn_DataData%OtherSt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%OtherSt.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcBeamDyn_DataData%OtherSt,2), UBOUND(SrcBeamDyn_DataData%OtherSt,2) - DO i1 = LBOUND(SrcBeamDyn_DataData%OtherSt,1), UBOUND(SrcBeamDyn_DataData%OtherSt,1) - CALL BD_CopyOtherState( SrcBeamDyn_DataData%OtherSt(i1,i2), DstBeamDyn_DataData%OtherSt(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcBeamDyn_DataData%p)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%p,1) - i1_u = UBOUND(SrcBeamDyn_DataData%p,1) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%p)) THEN - ALLOCATE(DstBeamDyn_DataData%p(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%p.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcBeamDyn_DataData%p,1), UBOUND(SrcBeamDyn_DataData%p,1) - CALL BD_CopyParam( SrcBeamDyn_DataData%p(i1), DstBeamDyn_DataData%p(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcBeamDyn_DataData%u)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%u,1) - i1_u = UBOUND(SrcBeamDyn_DataData%u,1) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%u)) THEN - ALLOCATE(DstBeamDyn_DataData%u(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%u.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcBeamDyn_DataData%u,1), UBOUND(SrcBeamDyn_DataData%u,1) - CALL BD_CopyInput( SrcBeamDyn_DataData%u(i1), DstBeamDyn_DataData%u(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcBeamDyn_DataData%y)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%y,1) - i1_u = UBOUND(SrcBeamDyn_DataData%y,1) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%y)) THEN - ALLOCATE(DstBeamDyn_DataData%y(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%y.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcBeamDyn_DataData%y,1), UBOUND(SrcBeamDyn_DataData%y,1) - CALL BD_CopyOutput( SrcBeamDyn_DataData%y(i1), DstBeamDyn_DataData%y(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcBeamDyn_DataData%m)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%m,1) - i1_u = UBOUND(SrcBeamDyn_DataData%m,1) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%m)) THEN - ALLOCATE(DstBeamDyn_DataData%m(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%m.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcBeamDyn_DataData%m,1), UBOUND(SrcBeamDyn_DataData%m,1) - CALL BD_CopyMisc( SrcBeamDyn_DataData%m(i1), DstBeamDyn_DataData%m(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcBeamDyn_DataData%Input)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%Input,1) - i1_u = UBOUND(SrcBeamDyn_DataData%Input,1) - i2_l = LBOUND(SrcBeamDyn_DataData%Input,2) - i2_u = UBOUND(SrcBeamDyn_DataData%Input,2) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%Input)) THEN - ALLOCATE(DstBeamDyn_DataData%Input(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i2 = LBOUND(SrcBeamDyn_DataData%Input,2), UBOUND(SrcBeamDyn_DataData%Input,2) - DO i1 = LBOUND(SrcBeamDyn_DataData%Input,1), UBOUND(SrcBeamDyn_DataData%Input,1) - CALL BD_CopyInput( SrcBeamDyn_DataData%Input(i1,i2), DstBeamDyn_DataData%Input(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - ENDDO -ENDIF -IF (ALLOCATED(SrcBeamDyn_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcBeamDyn_DataData%InputTimes,1) - i1_u = UBOUND(SrcBeamDyn_DataData%InputTimes,1) - i2_l = LBOUND(SrcBeamDyn_DataData%InputTimes,2) - i2_u = UBOUND(SrcBeamDyn_DataData%InputTimes,2) - IF (.NOT. ALLOCATED(DstBeamDyn_DataData%InputTimes)) THEN - ALLOCATE(DstBeamDyn_DataData%InputTimes(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstBeamDyn_DataData%InputTimes = SrcBeamDyn_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyBeamDyn_Data - - SUBROUTINE FAST_DestroyBeamDyn_Data( BeamDyn_DataData, ErrStat, ErrMsg ) - TYPE(BeamDyn_Data), INTENT(INOUT) :: BeamDyn_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyBeamDyn_Data' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -IF (ALLOCATED(BeamDyn_DataData%x)) THEN -DO i2 = LBOUND(BeamDyn_DataData%x,2), UBOUND(BeamDyn_DataData%x,2) -DO i1 = LBOUND(BeamDyn_DataData%x,1), UBOUND(BeamDyn_DataData%x,1) - CALL BD_DestroyContState( BeamDyn_DataData%x(i1,i2), ErrStat, ErrMsg ) -ENDDO -ENDDO - DEALLOCATE(BeamDyn_DataData%x) -ENDIF -IF (ALLOCATED(BeamDyn_DataData%xd)) THEN -DO i2 = LBOUND(BeamDyn_DataData%xd,2), UBOUND(BeamDyn_DataData%xd,2) -DO i1 = LBOUND(BeamDyn_DataData%xd,1), UBOUND(BeamDyn_DataData%xd,1) - CALL BD_DestroyDiscState( BeamDyn_DataData%xd(i1,i2), ErrStat, ErrMsg ) -ENDDO -ENDDO - DEALLOCATE(BeamDyn_DataData%xd) -ENDIF -IF (ALLOCATED(BeamDyn_DataData%z)) THEN -DO i2 = LBOUND(BeamDyn_DataData%z,2), UBOUND(BeamDyn_DataData%z,2) -DO i1 = LBOUND(BeamDyn_DataData%z,1), UBOUND(BeamDyn_DataData%z,1) - CALL BD_DestroyConstrState( BeamDyn_DataData%z(i1,i2), ErrStat, ErrMsg ) -ENDDO -ENDDO - DEALLOCATE(BeamDyn_DataData%z) -ENDIF -IF (ALLOCATED(BeamDyn_DataData%OtherSt)) THEN -DO i2 = LBOUND(BeamDyn_DataData%OtherSt,2), UBOUND(BeamDyn_DataData%OtherSt,2) -DO i1 = LBOUND(BeamDyn_DataData%OtherSt,1), UBOUND(BeamDyn_DataData%OtherSt,1) - CALL BD_DestroyOtherState( BeamDyn_DataData%OtherSt(i1,i2), ErrStat, ErrMsg ) -ENDDO -ENDDO - DEALLOCATE(BeamDyn_DataData%OtherSt) -ENDIF -IF (ALLOCATED(BeamDyn_DataData%p)) THEN -DO i1 = LBOUND(BeamDyn_DataData%p,1), UBOUND(BeamDyn_DataData%p,1) - CALL BD_DestroyParam( BeamDyn_DataData%p(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(BeamDyn_DataData%p) -ENDIF -IF (ALLOCATED(BeamDyn_DataData%u)) THEN -DO i1 = LBOUND(BeamDyn_DataData%u,1), UBOUND(BeamDyn_DataData%u,1) - CALL BD_DestroyInput( BeamDyn_DataData%u(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(BeamDyn_DataData%u) -ENDIF -IF (ALLOCATED(BeamDyn_DataData%y)) THEN -DO i1 = LBOUND(BeamDyn_DataData%y,1), UBOUND(BeamDyn_DataData%y,1) - CALL BD_DestroyOutput( BeamDyn_DataData%y(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(BeamDyn_DataData%y) -ENDIF -IF (ALLOCATED(BeamDyn_DataData%m)) THEN -DO i1 = LBOUND(BeamDyn_DataData%m,1), UBOUND(BeamDyn_DataData%m,1) - CALL BD_DestroyMisc( BeamDyn_DataData%m(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(BeamDyn_DataData%m) -ENDIF -IF (ALLOCATED(BeamDyn_DataData%Input)) THEN -DO i2 = LBOUND(BeamDyn_DataData%Input,2), UBOUND(BeamDyn_DataData%Input,2) -DO i1 = LBOUND(BeamDyn_DataData%Input,1), UBOUND(BeamDyn_DataData%Input,1) - CALL BD_DestroyInput( BeamDyn_DataData%Input(i1,i2), ErrStat, ErrMsg ) -ENDDO -ENDDO - DEALLOCATE(BeamDyn_DataData%Input) -ENDIF -IF (ALLOCATED(BeamDyn_DataData%InputTimes)) THEN - DEALLOCATE(BeamDyn_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroyBeamDyn_Data - - SUBROUTINE FAST_PackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(BeamDyn_Data), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackBeamDyn_Data' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! x allocated yes/no - IF ( ALLOCATED(InData%x) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! x upper/lower bounds for each dimension - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i2 = LBOUND(InData%x,2), UBOUND(InData%x,2) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL BD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! xd allocated yes/no - IF ( ALLOCATED(InData%xd) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! xd upper/lower bounds for each dimension - DO i2 = LBOUND(InData%xd,2), UBOUND(InData%xd,2) - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL BD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! z allocated yes/no - IF ( ALLOCATED(InData%z) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! z upper/lower bounds for each dimension - DO i2 = LBOUND(InData%z,2), UBOUND(InData%z,2) - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL BD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! OtherSt allocated yes/no - IF ( ALLOCATED(InData%OtherSt) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! OtherSt upper/lower bounds for each dimension - DO i2 = LBOUND(InData%OtherSt,2), UBOUND(InData%OtherSt,2) - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL BD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! p allocated yes/no - IF ( ALLOCATED(InData%p) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! p upper/lower bounds for each dimension - DO i1 = LBOUND(InData%p,1), UBOUND(InData%p,1) - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL BD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p(i1), ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! u allocated yes/no - IF ( ALLOCATED(InData%u) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u upper/lower bounds for each dimension - DO i1 = LBOUND(InData%u,1), UBOUND(InData%u,1) - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL BD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! y allocated yes/no - IF ( ALLOCATED(InData%y) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! y upper/lower bounds for each dimension - DO i1 = LBOUND(InData%y,1), UBOUND(InData%y,1) - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL BD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y(i1), ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! m allocated yes/no - IF ( ALLOCATED(InData%m) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! m upper/lower bounds for each dimension - DO i1 = LBOUND(InData%m,1), UBOUND(InData%m,1) - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL BD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m(i1), ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Input upper/lower bounds for each dimension - DO i2 = LBOUND(InData%Input,2), UBOUND(InData%Input,2) - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL BD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Input - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no - IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! InputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%x) ) THEN + IF ( .NOT. ALLOCATED(InData%xd_MAP) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%x,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%x,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x,2) + IntKiBuf( Int_Xferred ) = LBOUND(InData%xd_MAP,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_MAP,1) Int_Xferred = Int_Xferred + 2 - DO i2 = LBOUND(InData%x,2), UBOUND(InData%x,2) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL BD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! x + DO i1 = LBOUND(InData%xd_MAP,1), UBOUND(InData%xd_MAP,1) + CALL MAP_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_MAP(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd_MAP CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7294,24 +8158,19 @@ SUBROUTINE FAST_PackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF END DO - END DO END IF - IF ( .NOT. ALLOCATED(InData%xd) ) THEN + IF ( .NOT. ALLOCATED(InData%z_MAP) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xd,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%xd,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd,2) + IntKiBuf( Int_Xferred ) = LBOUND(InData%z_MAP,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_MAP,1) Int_Xferred = Int_Xferred + 2 - DO i2 = LBOUND(InData%xd,2), UBOUND(InData%xd,2) - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL BD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! xd + DO i1 = LBOUND(InData%z_MAP,1), UBOUND(InData%z_MAP,1) + CALL MAP_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_MAP(i1), ErrStat2, ErrMsg2, OnlySize ) ! z_MAP CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7340,24 +8199,19 @@ SUBROUTINE FAST_PackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF END DO - END DO END IF - IF ( .NOT. ALLOCATED(InData%z) ) THEN + IF ( .NOT. ALLOCATED(InData%u_MAP) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%z,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%z,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z,2) + IntKiBuf( Int_Xferred ) = LBOUND(InData%u_MAP,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_MAP,1) Int_Xferred = Int_Xferred + 2 - DO i2 = LBOUND(InData%z,2), UBOUND(InData%z,2) - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL BD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! z + DO i1 = LBOUND(InData%u_MAP,1), UBOUND(InData%u_MAP,1) + CALL MAP_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_MAP(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_MAP CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7386,24 +8240,19 @@ SUBROUTINE FAST_PackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF END DO - END DO END IF - IF ( .NOT. ALLOCATED(InData%OtherSt) ) THEN + IF ( .NOT. ALLOCATED(InData%x_FEAM) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt,2) + IntKiBuf( Int_Xferred ) = LBOUND(InData%x_FEAM,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_FEAM,1) Int_Xferred = Int_Xferred + 2 - DO i2 = LBOUND(InData%OtherSt,2), UBOUND(InData%OtherSt,2) - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL BD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt + DO i1 = LBOUND(InData%x_FEAM,1), UBOUND(InData%x_FEAM,1) + CALL FEAM_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_FEAM(i1), ErrStat2, ErrMsg2, OnlySize ) ! x_FEAM CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7432,20 +8281,19 @@ SUBROUTINE FAST_PackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF END DO - END DO END IF - IF ( .NOT. ALLOCATED(InData%p) ) THEN + IF ( .NOT. ALLOCATED(InData%xd_FEAM) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%p,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%p,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%xd_FEAM,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_FEAM,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%p,1), UBOUND(InData%p,1) - CALL BD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p(i1), ErrStat2, ErrMsg2, OnlySize ) ! p + DO i1 = LBOUND(InData%xd_FEAM,1), UBOUND(InData%xd_FEAM,1) + CALL FEAM_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_FEAM(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd_FEAM CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7475,18 +8323,18 @@ SUBROUTINE FAST_PackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ENDIF END DO END IF - IF ( .NOT. ALLOCATED(InData%u) ) THEN + IF ( .NOT. ALLOCATED(InData%z_FEAM) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%z_FEAM,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_FEAM,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%u,1), UBOUND(InData%u,1) - CALL BD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u(i1), ErrStat2, ErrMsg2, OnlySize ) ! u + DO i1 = LBOUND(InData%z_FEAM,1), UBOUND(InData%z_FEAM,1) + CALL FEAM_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_FEAM(i1), ErrStat2, ErrMsg2, OnlySize ) ! z_FEAM CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7516,18 +8364,18 @@ SUBROUTINE FAST_PackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ENDIF END DO END IF - IF ( .NOT. ALLOCATED(InData%y) ) THEN + IF ( .NOT. ALLOCATED(InData%OtherSt_FEAM) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%y,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt_FEAM,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_FEAM,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%y,1), UBOUND(InData%y,1) - CALL BD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y(i1), ErrStat2, ErrMsg2, OnlySize ) ! y + DO i1 = LBOUND(InData%OtherSt_FEAM,1), UBOUND(InData%OtherSt_FEAM,1) + CALL FEAM_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_FEAM(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt_FEAM CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7557,18 +8405,18 @@ SUBROUTINE FAST_PackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ENDIF END DO END IF - IF ( .NOT. ALLOCATED(InData%m) ) THEN + IF ( .NOT. ALLOCATED(InData%u_FEAM) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%m,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%m,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%u_FEAM,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_FEAM,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%m,1), UBOUND(InData%m,1) - CALL BD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m(i1), ErrStat2, ErrMsg2, OnlySize ) ! m + DO i1 = LBOUND(InData%u_FEAM,1), UBOUND(InData%u_FEAM,1) + CALL FEAM_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_FEAM(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_FEAM CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7598,22 +8446,59 @@ SUBROUTINE FAST_PackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ENDIF END DO END IF - IF ( .NOT. ALLOCATED(InData%Input) ) THEN + IF ( .NOT. ALLOCATED(InData%x_MD) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%x_MD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x_MD,1) Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,2) + + DO i1 = LBOUND(InData%x_MD,1), UBOUND(InData%x_MD,1) + CALL MD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x_MD(i1), ErrStat2, ErrMsg2, OnlySize ) ! x_MD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%xd_MD) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%xd_MD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_MD,1) Int_Xferred = Int_Xferred + 2 - DO i2 = LBOUND(InData%Input,2), UBOUND(InData%Input,2) - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL BD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! Input + DO i1 = LBOUND(InData%xd_MD,1), UBOUND(InData%xd_MD,1) + CALL MD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd_MD(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd_MD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7642,31 +8527,137 @@ SUBROUTINE FAST_PackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF END DO + END IF + IF ( .NOT. ALLOCATED(InData%z_MD) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%z_MD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z_MD,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%z_MD,1), UBOUND(InData%z_MD,1) + CALL MD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z_MD(i1), ErrStat2, ErrMsg2, OnlySize ) ! z_MD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF END DO END IF - IF ( .NOT. ALLOCATED(InData%InputTimes) ) THEN + IF ( .NOT. ALLOCATED(InData%OtherSt_MD) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt_MD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt_MD,1) Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,2) + + DO i1 = LBOUND(InData%OtherSt_MD,1), UBOUND(InData%OtherSt_MD,1) + CALL MD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_MD(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt_MD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%u_MD) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%u_MD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_MD,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%InputTimes)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%InputTimes))-1 ) = PACK(InData%InputTimes,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%InputTimes) + DO i1 = LBOUND(InData%u_MD,1), UBOUND(InData%u_MD,1) + CALL MD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u_MD(i1), ErrStat2, ErrMsg2, OnlySize ) ! u_MD + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO END IF - END SUBROUTINE FAST_PackBeamDyn_Data + END SUBROUTINE FAST_PackLinStateSave - SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + SUBROUTINE FAST_UnPackLinStateSave( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(BeamDyn_Data), INTENT(INOUT) :: OutData + TYPE(FAST_LinStateSave), INTENT(INOUT) :: OutData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local variables @@ -7675,17 +8666,11 @@ SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackBeamDyn_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackLinStateSave' ! buffers to store meshes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -7696,7 +8681,7 @@ SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x_IceD not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 @@ -7706,14 +8691,14 @@ SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat i2_l = IntKiBuf( Int_Xferred ) i2_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%x)) DEALLOCATE(OutData%x) - ALLOCATE(OutData%x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%x_IceD)) DEALLOCATE(OutData%x_IceD) + ALLOCATE(OutData%x_IceD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_IceD.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i2 = LBOUND(OutData%x,2), UBOUND(OutData%x,2) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) + DO i2 = LBOUND(OutData%x_IceD,2), UBOUND(OutData%x_IceD,2) + DO i1 = LBOUND(OutData%x_IceD,1), UBOUND(OutData%x_IceD,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -7747,7 +8732,7 @@ SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL BD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1,i2), ErrStat2, ErrMsg2 ) ! x + CALL IceD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x_IceD(i1,i2), ErrStat2, ErrMsg2 ) ! x_IceD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7757,7 +8742,7 @@ SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xd not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xd_IceD not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 @@ -7767,14 +8752,14 @@ SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat i2_l = IntKiBuf( Int_Xferred ) i2_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%xd)) DEALLOCATE(OutData%xd) - ALLOCATE(OutData%xd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%xd_IceD)) DEALLOCATE(OutData%xd_IceD) + ALLOCATE(OutData%xd_IceD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_IceD.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i2 = LBOUND(OutData%xd,2), UBOUND(OutData%xd,2) - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,1) + DO i2 = LBOUND(OutData%xd_IceD,2), UBOUND(OutData%xd_IceD,2) + DO i1 = LBOUND(OutData%xd_IceD,1), UBOUND(OutData%xd_IceD,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -7808,7 +8793,7 @@ SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL BD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1,i2), ErrStat2, ErrMsg2 ) ! xd + CALL IceD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd_IceD(i1,i2), ErrStat2, ErrMsg2 ) ! xd_IceD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7818,7 +8803,7 @@ SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z_IceD not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 @@ -7828,14 +8813,14 @@ SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat i2_l = IntKiBuf( Int_Xferred ) i2_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%z)) DEALLOCATE(OutData%z) - ALLOCATE(OutData%z(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%z_IceD)) DEALLOCATE(OutData%z_IceD) + ALLOCATE(OutData%z_IceD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_IceD.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i2 = LBOUND(OutData%z,2), UBOUND(OutData%z,2) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) + DO i2 = LBOUND(OutData%z_IceD,2), UBOUND(OutData%z_IceD,2) + DO i1 = LBOUND(OutData%z_IceD,1), UBOUND(OutData%z_IceD,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -7869,7 +8854,7 @@ SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL BD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1,i2), ErrStat2, ErrMsg2 ) ! z + CALL IceD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z_IceD(i1,i2), ErrStat2, ErrMsg2 ) ! z_IceD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7879,7 +8864,7 @@ SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OtherSt not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OtherSt_IceD not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 @@ -7889,14 +8874,14 @@ SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat i2_l = IntKiBuf( Int_Xferred ) i2_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%OtherSt)) DEALLOCATE(OutData%OtherSt) - ALLOCATE(OutData%OtherSt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%OtherSt_IceD)) DEALLOCATE(OutData%OtherSt_IceD) + ALLOCATE(OutData%OtherSt_IceD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_IceD.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i2 = LBOUND(OutData%OtherSt,2), UBOUND(OutData%OtherSt,2) - DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,1) + DO i2 = LBOUND(OutData%OtherSt_IceD,2), UBOUND(OutData%OtherSt_IceD,2) + DO i1 = LBOUND(OutData%OtherSt_IceD,1), UBOUND(OutData%OtherSt_IceD,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -7930,7 +8915,7 @@ SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL BD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1,i2), ErrStat2, ErrMsg2 ) ! OtherSt + CALL IceD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_IceD(i1,i2), ErrStat2, ErrMsg2 ) ! OtherSt_IceD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -7940,76 +8925,24 @@ SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! p not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_IceD not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%p)) DEALLOCATE(OutData%p) - ALLOCATE(OutData%p(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%p.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%p,1), UBOUND(OutData%p,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL BD_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p(i1), ErrStat2, ErrMsg2 ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%u)) DEALLOCATE(OutData%u) - ALLOCATE(OutData%u(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%u_IceD)) DEALLOCATE(OutData%u_IceD) + ALLOCATE(OutData%u_IceD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_IceD.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%u,1), UBOUND(OutData%u,1) + DO i2 = LBOUND(OutData%u_IceD,2), UBOUND(OutData%u_IceD,2) + DO i1 = LBOUND(OutData%u_IceD,1), UBOUND(OutData%u_IceD,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -8043,7 +8976,7 @@ SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL BD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u(i1), ErrStat2, ErrMsg2 ) ! u + CALL IceD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_IceD(i1,i2), ErrStat2, ErrMsg2 ) ! u_IceD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -8051,21 +8984,26 @@ SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO + END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! y not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x_BD not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%y)) DEALLOCATE(OutData%y) - ALLOCATE(OutData%y(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%x_BD)) DEALLOCATE(OutData%x_BD) + ALLOCATE(OutData%x_BD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_BD.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%y,1), UBOUND(OutData%y,1) + DO i2 = LBOUND(OutData%x_BD,2), UBOUND(OutData%x_BD,2) + DO i1 = LBOUND(OutData%x_BD,1), UBOUND(OutData%x_BD,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -8099,7 +9037,7 @@ SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL BD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y(i1), ErrStat2, ErrMsg2 ) ! y + CALL BD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x_BD(i1,i2), ErrStat2, ErrMsg2 ) ! x_BD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -8107,21 +9045,26 @@ SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO + END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! m not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xd_BD not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%m)) DEALLOCATE(OutData%m) - ALLOCATE(OutData%m(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%xd_BD)) DEALLOCATE(OutData%xd_BD) + ALLOCATE(OutData%xd_BD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%m.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_BD.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%m,1), UBOUND(OutData%m,1) + DO i2 = LBOUND(OutData%xd_BD,2), UBOUND(OutData%xd_BD,2) + DO i1 = LBOUND(OutData%xd_BD,1), UBOUND(OutData%xd_BD,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -8155,7 +9098,7 @@ SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL BD_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m(i1), ErrStat2, ErrMsg2 ) ! m + CALL BD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd_BD(i1,i2), ErrStat2, ErrMsg2 ) ! xd_BD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -8163,8 +9106,9 @@ SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO + END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z_BD not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 @@ -8174,14 +9118,14 @@ SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat i2_l = IntKiBuf( Int_Xferred ) i2_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%z_BD)) DEALLOCATE(OutData%z_BD) + ALLOCATE(OutData%z_BD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_BD.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i2 = LBOUND(OutData%Input,2), UBOUND(OutData%Input,2) - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,1) + DO i2 = LBOUND(OutData%z_BD,2), UBOUND(OutData%z_BD,2) + DO i1 = LBOUND(OutData%z_BD,1), UBOUND(OutData%z_BD,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -8215,7 +9159,7 @@ SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL BD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1,i2), ErrStat2, ErrMsg2 ) ! Input + CALL BD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z_BD(i1,i2), ErrStat2, ErrMsg2 ) ! z_BD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -8225,7 +9169,7 @@ SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat END DO END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OtherSt_BD not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 @@ -8235,782 +9179,300 @@ SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat i2_l = IntKiBuf( Int_Xferred ) i2_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%OtherSt_BD)) DEALLOCATE(OutData%OtherSt_BD) + ALLOCATE(OutData%OtherSt_BD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_BD.', ErrStat, ErrMsg,RoutineName) RETURN END IF - mask2 = .TRUE. - IF (SIZE(OutData%InputTimes)>0) OutData%InputTimes = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%InputTimes))-1 ), mask2, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%InputTimes) - DEALLOCATE(mask2) - END IF - END SUBROUTINE FAST_UnPackBeamDyn_Data - - SUBROUTINE FAST_CopyElastoDyn_Data( SrcElastoDyn_DataData, DstElastoDyn_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ElastoDyn_Data), INTENT(INOUT) :: SrcElastoDyn_DataData - TYPE(ElastoDyn_Data), INTENT(INOUT) :: DstElastoDyn_DataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyElastoDyn_Data' -! - ErrStat = ErrID_None - ErrMsg = "" - DO i1 = LBOUND(SrcElastoDyn_DataData%x,1), UBOUND(SrcElastoDyn_DataData%x,1) - CALL ED_CopyContState( SrcElastoDyn_DataData%x(i1), DstElastoDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcElastoDyn_DataData%xd,1), UBOUND(SrcElastoDyn_DataData%xd,1) - CALL ED_CopyDiscState( SrcElastoDyn_DataData%xd(i1), DstElastoDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcElastoDyn_DataData%z,1), UBOUND(SrcElastoDyn_DataData%z,1) - CALL ED_CopyConstrState( SrcElastoDyn_DataData%z(i1), DstElastoDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcElastoDyn_DataData%OtherSt,1), UBOUND(SrcElastoDyn_DataData%OtherSt,1) - CALL ED_CopyOtherState( SrcElastoDyn_DataData%OtherSt(i1), DstElastoDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL ED_CopyParam( SrcElastoDyn_DataData%p, DstElastoDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL ED_CopyInput( SrcElastoDyn_DataData%u, DstElastoDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL ED_CopyOutput( SrcElastoDyn_DataData%y, DstElastoDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL ED_CopyMisc( SrcElastoDyn_DataData%m, DstElastoDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcElastoDyn_DataData%Output)) THEN - i1_l = LBOUND(SrcElastoDyn_DataData%Output,1) - i1_u = UBOUND(SrcElastoDyn_DataData%Output,1) - IF (.NOT. ALLOCATED(DstElastoDyn_DataData%Output)) THEN - ALLOCATE(DstElastoDyn_DataData%Output(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%Output.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcElastoDyn_DataData%Output,1), UBOUND(SrcElastoDyn_DataData%Output,1) - CALL ED_CopyOutput( SrcElastoDyn_DataData%Output(i1), DstElastoDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcElastoDyn_DataData%Input)) THEN - i1_l = LBOUND(SrcElastoDyn_DataData%Input,1) - i1_u = UBOUND(SrcElastoDyn_DataData%Input,1) - IF (.NOT. ALLOCATED(DstElastoDyn_DataData%Input)) THEN - ALLOCATE(DstElastoDyn_DataData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcElastoDyn_DataData%Input,1), UBOUND(SrcElastoDyn_DataData%Input,1) - CALL ED_CopyInput( SrcElastoDyn_DataData%Input(i1), DstElastoDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcElastoDyn_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcElastoDyn_DataData%InputTimes,1) - i1_u = UBOUND(SrcElastoDyn_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstElastoDyn_DataData%InputTimes)) THEN - ALLOCATE(DstElastoDyn_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstElastoDyn_DataData%InputTimes = SrcElastoDyn_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyElastoDyn_Data - - SUBROUTINE FAST_DestroyElastoDyn_Data( ElastoDyn_DataData, ErrStat, ErrMsg ) - TYPE(ElastoDyn_Data), INTENT(INOUT) :: ElastoDyn_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyElastoDyn_Data' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -DO i1 = LBOUND(ElastoDyn_DataData%x,1), UBOUND(ElastoDyn_DataData%x,1) - CALL ED_DestroyContState( ElastoDyn_DataData%x(i1), ErrStat, ErrMsg ) -ENDDO -DO i1 = LBOUND(ElastoDyn_DataData%xd,1), UBOUND(ElastoDyn_DataData%xd,1) - CALL ED_DestroyDiscState( ElastoDyn_DataData%xd(i1), ErrStat, ErrMsg ) -ENDDO -DO i1 = LBOUND(ElastoDyn_DataData%z,1), UBOUND(ElastoDyn_DataData%z,1) - CALL ED_DestroyConstrState( ElastoDyn_DataData%z(i1), ErrStat, ErrMsg ) -ENDDO -DO i1 = LBOUND(ElastoDyn_DataData%OtherSt,1), UBOUND(ElastoDyn_DataData%OtherSt,1) - CALL ED_DestroyOtherState( ElastoDyn_DataData%OtherSt(i1), ErrStat, ErrMsg ) -ENDDO - CALL ED_DestroyParam( ElastoDyn_DataData%p, ErrStat, ErrMsg ) - CALL ED_DestroyInput( ElastoDyn_DataData%u, ErrStat, ErrMsg ) - CALL ED_DestroyOutput( ElastoDyn_DataData%y, ErrStat, ErrMsg ) - CALL ED_DestroyMisc( ElastoDyn_DataData%m, ErrStat, ErrMsg ) -IF (ALLOCATED(ElastoDyn_DataData%Output)) THEN -DO i1 = LBOUND(ElastoDyn_DataData%Output,1), UBOUND(ElastoDyn_DataData%Output,1) - CALL ED_DestroyOutput( ElastoDyn_DataData%Output(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(ElastoDyn_DataData%Output) -ENDIF -IF (ALLOCATED(ElastoDyn_DataData%Input)) THEN -DO i1 = LBOUND(ElastoDyn_DataData%Input,1), UBOUND(ElastoDyn_DataData%Input,1) - CALL ED_DestroyInput( ElastoDyn_DataData%Input(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(ElastoDyn_DataData%Input) -ENDIF -IF (ALLOCATED(ElastoDyn_DataData%InputTimes)) THEN - DEALLOCATE(ElastoDyn_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroyElastoDyn_Data - - SUBROUTINE FAST_PackElastoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(ElastoDyn_Data), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackElastoDyn_Data' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL ED_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + DO i2 = LBOUND(OutData%OtherSt_BD,2), UBOUND(OutData%OtherSt_BD,2) + DO i1 = LBOUND(OutData%OtherSt_BD,1), UBOUND(OutData%OtherSt_BD,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL ED_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd + CALL BD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_BD(i1,i2), ErrStat2, ErrMsg2 ) ! OtherSt_BD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL ED_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_BD not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%u_BD)) DEALLOCATE(OutData%u_BD) + ALLOCATE(OutData%u_BD(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_BD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%u_BD,2), UBOUND(OutData%u_BD,2) + DO i1 = LBOUND(OutData%u_BD,1), UBOUND(OutData%u_BD,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL ED_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt + CALL BD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_BD(i1,i2), ErrStat2, ErrMsg2 ) ! u_BD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x_ED not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%x_ED)) DEALLOCATE(OutData%x_ED) + ALLOCATE(OutData%x_ED(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_ED.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%x_ED,1), UBOUND(OutData%x_ED,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - END DO - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL ED_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p + CALL ED_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x_ED(i1), ErrStat2, ErrMsg2 ) ! x_ED CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xd_ED not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%xd_ED)) DEALLOCATE(OutData%xd_ED) + ALLOCATE(OutData%xd_ED(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_ED.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%xd_ED,1), UBOUND(OutData%xd_ED,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL ED_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u + CALL ED_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd_ED(i1), ErrStat2, ErrMsg2 ) ! xd_ED CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z_ED not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%z_ED)) DEALLOCATE(OutData%z_ED) + ALLOCATE(OutData%z_ED(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_ED.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%z_ED,1), UBOUND(OutData%z_ED,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL ED_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y + CALL ED_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z_ED(i1), ErrStat2, ErrMsg2 ) ! z_ED CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL ED_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Output allocated yes/no - IF ( ALLOCATED(InData%Output) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Output upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) - Int_BufSz = Int_BufSz + 3 ! Output: size of buffers for each call to pack subtype - CALL ED_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Output - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Output - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Output - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Output - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL ED_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Input - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no - IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL ED_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL ED_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL ED_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL ED_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - CALL ED_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL ED_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL ED_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL ED_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%Output) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Output,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Output,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) - CALL ED_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, OnlySize ) ! Output - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Input) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL ED_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - IF ( .NOT. ALLOCATED(InData%InputTimes) ) THEN - IntKiBuf( Int_Xferred ) = 0 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OtherSt_ED not allocated Int_Xferred = Int_Xferred + 1 ELSE - IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%InputTimes)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%InputTimes))-1 ) = PACK(InData%InputTimes,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%InputTimes) - END IF - END SUBROUTINE FAST_PackElastoDyn_Data - - SUBROUTINE FAST_UnPackElastoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(ElastoDyn_Data), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackElastoDyn_Data' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - i1_l = LBOUND(OutData%x,1) - i1_u = UBOUND(OutData%x,1) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) + IF (ALLOCATED(OutData%OtherSt_ED)) DEALLOCATE(OutData%OtherSt_ED) + ALLOCATE(OutData%OtherSt_ED(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_ED.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%OtherSt_ED,1), UBOUND(OutData%OtherSt_ED,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -9044,7 +9506,7 @@ SUBROUTINE FAST_UnPackElastoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL ED_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x + CALL ED_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_ED(i1), ErrStat2, ErrMsg2 ) ! OtherSt_ED CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -9052,9 +9514,21 @@ SUBROUTINE FAST_UnPackElastoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO - i1_l = LBOUND(OutData%xd,1) - i1_u = UBOUND(OutData%xd,1) - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,1) + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_ED not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%u_ED)) DEALLOCATE(OutData%u_ED) + ALLOCATE(OutData%u_ED(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_ED.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%u_ED,1), UBOUND(OutData%u_ED,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -9088,7 +9562,7 @@ SUBROUTINE FAST_UnPackElastoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL ED_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd + CALL ED_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_ED(i1), ErrStat2, ErrMsg2 ) ! u_ED CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -9096,9 +9570,21 @@ SUBROUTINE FAST_UnPackElastoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO - i1_l = LBOUND(OutData%z,1) - i1_u = UBOUND(OutData%z,1) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x_SrvD not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%x_SrvD)) DEALLOCATE(OutData%x_SrvD) + ALLOCATE(OutData%x_SrvD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_SrvD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%x_SrvD,1), UBOUND(OutData%x_SrvD,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -9132,7 +9618,7 @@ SUBROUTINE FAST_UnPackElastoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL ED_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z + CALL SrvD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x_SrvD(i1), ErrStat2, ErrMsg2 ) ! x_SrvD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -9140,9 +9626,21 @@ SUBROUTINE FAST_UnPackElastoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO - i1_l = LBOUND(OutData%OtherSt,1) - i1_u = UBOUND(OutData%OtherSt,1) - DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,1) + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xd_SrvD not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%xd_SrvD)) DEALLOCATE(OutData%xd_SrvD) + ALLOCATE(OutData%xd_SrvD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_SrvD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%xd_SrvD,1), UBOUND(OutData%xd_SrvD,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -9176,7 +9674,7 @@ SUBROUTINE FAST_UnPackElastoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL ED_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt + CALL SrvD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd_SrvD(i1), ErrStat2, ErrMsg2 ) ! xd_SrvD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -9184,6 +9682,21 @@ SUBROUTINE FAST_UnPackElastoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z_SrvD not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%z_SrvD)) DEALLOCATE(OutData%z_SrvD) + ALLOCATE(OutData%z_SrvD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_SrvD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%z_SrvD,1), UBOUND(OutData%z_SrvD,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -9217,13 +9730,29 @@ SUBROUTINE FAST_UnPackElastoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL ED_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p + CALL SrvD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z_SrvD(i1), ErrStat2, ErrMsg2 ) ! z_SrvD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OtherSt_SrvD not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%OtherSt_SrvD)) DEALLOCATE(OutData%OtherSt_SrvD) + ALLOCATE(OutData%OtherSt_SrvD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_SrvD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%OtherSt_SrvD,1), UBOUND(OutData%OtherSt_SrvD,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -9257,13 +9786,29 @@ SUBROUTINE FAST_UnPackElastoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL ED_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u + CALL SrvD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_SrvD(i1), ErrStat2, ErrMsg2 ) ! OtherSt_SrvD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_SrvD not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%u_SrvD)) DEALLOCATE(OutData%u_SrvD) + ALLOCATE(OutData%u_SrvD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_SrvD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%u_SrvD,1), UBOUND(OutData%u_SrvD,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -9297,13 +9842,29 @@ SUBROUTINE FAST_UnPackElastoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL ED_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y + CALL SrvD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_SrvD(i1), ErrStat2, ErrMsg2 ) ! u_SrvD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x_AD not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%x_AD)) DEALLOCATE(OutData%x_AD) + ALLOCATE(OutData%x_AD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_AD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%x_AD,1), UBOUND(OutData%x_AD,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -9337,27 +9898,29 @@ SUBROUTINE FAST_UnPackElastoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL ED_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m + CALL AD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x_AD(i1), ErrStat2, ErrMsg2 ) ! x_AD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Output not allocated + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xd_AD not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Output)) DEALLOCATE(OutData%Output) - ALLOCATE(OutData%Output(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%xd_AD)) DEALLOCATE(OutData%xd_AD) + ALLOCATE(OutData%xd_AD(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_AD.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%Output,1), UBOUND(OutData%Output,1) + DO i1 = LBOUND(OutData%xd_AD,1), UBOUND(OutData%xd_AD,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -9391,7 +9954,7 @@ SUBROUTINE FAST_UnPackElastoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL ED_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%Output(i1), ErrStat2, ErrMsg2 ) ! Output + CALL AD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd_AD(i1), ErrStat2, ErrMsg2 ) ! xd_AD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -9400,20 +9963,20 @@ SUBROUTINE FAST_UnPackElastoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z_AD not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%z_AD)) DEALLOCATE(OutData%z_AD) + ALLOCATE(OutData%z_AD(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_AD.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,1) + DO i1 = LBOUND(OutData%z_AD,1), UBOUND(OutData%z_AD,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -9447,7 +10010,7 @@ SUBROUTINE FAST_UnPackElastoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL ED_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input + CALL AD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z_AD(i1), ErrStat2, ErrMsg2 ) ! z_AD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -9456,703 +10019,300 @@ SUBROUTINE FAST_UnPackElastoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OtherSt_AD not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%OtherSt_AD)) DEALLOCATE(OutData%OtherSt_AD) + ALLOCATE(OutData%OtherSt_AD(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_AD.', ErrStat, ErrMsg,RoutineName) RETURN END IF - mask1 = .TRUE. - IF (SIZE(OutData%InputTimes)>0) OutData%InputTimes = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%InputTimes))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%InputTimes) - DEALLOCATE(mask1) - END IF - END SUBROUTINE FAST_UnPackElastoDyn_Data - - SUBROUTINE FAST_CopyServoDyn_Data( SrcServoDyn_DataData, DstServoDyn_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ServoDyn_Data), INTENT(INOUT) :: SrcServoDyn_DataData - TYPE(ServoDyn_Data), INTENT(INOUT) :: DstServoDyn_DataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyServoDyn_Data' -! - ErrStat = ErrID_None - ErrMsg = "" - DO i1 = LBOUND(SrcServoDyn_DataData%x,1), UBOUND(SrcServoDyn_DataData%x,1) - CALL SrvD_CopyContState( SrcServoDyn_DataData%x(i1), DstServoDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcServoDyn_DataData%xd,1), UBOUND(SrcServoDyn_DataData%xd,1) - CALL SrvD_CopyDiscState( SrcServoDyn_DataData%xd(i1), DstServoDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcServoDyn_DataData%z,1), UBOUND(SrcServoDyn_DataData%z,1) - CALL SrvD_CopyConstrState( SrcServoDyn_DataData%z(i1), DstServoDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcServoDyn_DataData%OtherSt,1), UBOUND(SrcServoDyn_DataData%OtherSt,1) - CALL SrvD_CopyOtherState( SrcServoDyn_DataData%OtherSt(i1), DstServoDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL SrvD_CopyParam( SrcServoDyn_DataData%p, DstServoDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SrvD_CopyInput( SrcServoDyn_DataData%u, DstServoDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SrvD_CopyOutput( SrcServoDyn_DataData%y, DstServoDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SrvD_CopyMisc( SrcServoDyn_DataData%m, DstServoDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcServoDyn_DataData%Input)) THEN - i1_l = LBOUND(SrcServoDyn_DataData%Input,1) - i1_u = UBOUND(SrcServoDyn_DataData%Input,1) - IF (.NOT. ALLOCATED(DstServoDyn_DataData%Input)) THEN - ALLOCATE(DstServoDyn_DataData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstServoDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcServoDyn_DataData%Input,1), UBOUND(SrcServoDyn_DataData%Input,1) - CALL SrvD_CopyInput( SrcServoDyn_DataData%Input(i1), DstServoDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcServoDyn_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcServoDyn_DataData%InputTimes,1) - i1_u = UBOUND(SrcServoDyn_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstServoDyn_DataData%InputTimes)) THEN - ALLOCATE(DstServoDyn_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstServoDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstServoDyn_DataData%InputTimes = SrcServoDyn_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyServoDyn_Data - - SUBROUTINE FAST_DestroyServoDyn_Data( ServoDyn_DataData, ErrStat, ErrMsg ) - TYPE(ServoDyn_Data), INTENT(INOUT) :: ServoDyn_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyServoDyn_Data' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -DO i1 = LBOUND(ServoDyn_DataData%x,1), UBOUND(ServoDyn_DataData%x,1) - CALL SrvD_DestroyContState( ServoDyn_DataData%x(i1), ErrStat, ErrMsg ) -ENDDO -DO i1 = LBOUND(ServoDyn_DataData%xd,1), UBOUND(ServoDyn_DataData%xd,1) - CALL SrvD_DestroyDiscState( ServoDyn_DataData%xd(i1), ErrStat, ErrMsg ) -ENDDO -DO i1 = LBOUND(ServoDyn_DataData%z,1), UBOUND(ServoDyn_DataData%z,1) - CALL SrvD_DestroyConstrState( ServoDyn_DataData%z(i1), ErrStat, ErrMsg ) -ENDDO -DO i1 = LBOUND(ServoDyn_DataData%OtherSt,1), UBOUND(ServoDyn_DataData%OtherSt,1) - CALL SrvD_DestroyOtherState( ServoDyn_DataData%OtherSt(i1), ErrStat, ErrMsg ) -ENDDO - CALL SrvD_DestroyParam( ServoDyn_DataData%p, ErrStat, ErrMsg ) - CALL SrvD_DestroyInput( ServoDyn_DataData%u, ErrStat, ErrMsg ) - CALL SrvD_DestroyOutput( ServoDyn_DataData%y, ErrStat, ErrMsg ) - CALL SrvD_DestroyMisc( ServoDyn_DataData%m, ErrStat, ErrMsg ) -IF (ALLOCATED(ServoDyn_DataData%Input)) THEN -DO i1 = LBOUND(ServoDyn_DataData%Input,1), UBOUND(ServoDyn_DataData%Input,1) - CALL SrvD_DestroyInput( ServoDyn_DataData%Input(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(ServoDyn_DataData%Input) -ENDIF -IF (ALLOCATED(ServoDyn_DataData%InputTimes)) THEN - DEALLOCATE(ServoDyn_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroyServoDyn_Data - - SUBROUTINE FAST_PackServoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(ServoDyn_Data), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackServoDyn_Data' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL SrvD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + DO i1 = LBOUND(OutData%OtherSt_AD,1), UBOUND(OutData%OtherSt_AD,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL SrvD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd + CALL AD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_AD(i1), ErrStat2, ErrMsg2 ) ! OtherSt_AD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL SrvD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_AD not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%u_AD)) DEALLOCATE(OutData%u_AD) + ALLOCATE(OutData%u_AD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_AD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%u_AD,1), UBOUND(OutData%u_AD,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL SrvD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt + CALL AD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_AD(i1), ErrStat2, ErrMsg2 ) ! u_AD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x_IfW not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%x_IfW)) DEALLOCATE(OutData%x_IfW) + ALLOCATE(OutData%x_IfW(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_IfW.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%x_IfW,1), UBOUND(OutData%x_IfW,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - END DO - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL SrvD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p + CALL InflowWind_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x_IfW(i1), ErrStat2, ErrMsg2 ) ! x_IfW CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xd_IfW not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%xd_IfW)) DEALLOCATE(OutData%xd_IfW) + ALLOCATE(OutData%xd_IfW(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_IfW.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%xd_IfW,1), UBOUND(OutData%xd_IfW,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL SrvD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u + CALL InflowWind_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd_IfW(i1), ErrStat2, ErrMsg2 ) ! xd_IfW CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z_IfW not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%z_IfW)) DEALLOCATE(OutData%z_IfW) + ALLOCATE(OutData%z_IfW(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_IfW.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%z_IfW,1), UBOUND(OutData%z_IfW,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL SrvD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y + CALL InflowWind_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z_IfW(i1), ErrStat2, ErrMsg2 ) ! z_IfW CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL SrvD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL SrvD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Input - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no - IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL SrvD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL SrvD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL SrvD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL SrvD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - CALL SrvD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL SrvD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL SrvD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL SrvD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%Input) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL SrvD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - IF ( .NOT. ALLOCATED(InData%InputTimes) ) THEN - IntKiBuf( Int_Xferred ) = 0 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OtherSt_IfW not allocated Int_Xferred = Int_Xferred + 1 ELSE - IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%InputTimes)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%InputTimes))-1 ) = PACK(InData%InputTimes,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%InputTimes) - END IF - END SUBROUTINE FAST_PackServoDyn_Data - - SUBROUTINE FAST_UnPackServoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(ServoDyn_Data), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackServoDyn_Data' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - i1_l = LBOUND(OutData%x,1) - i1_u = UBOUND(OutData%x,1) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) + IF (ALLOCATED(OutData%OtherSt_IfW)) DEALLOCATE(OutData%OtherSt_IfW) + ALLOCATE(OutData%OtherSt_IfW(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_IfW.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%OtherSt_IfW,1), UBOUND(OutData%OtherSt_IfW,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -10186,7 +10346,7 @@ SUBROUTINE FAST_UnPackServoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL SrvD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x + CALL InflowWind_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_IfW(i1), ErrStat2, ErrMsg2 ) ! OtherSt_IfW CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -10194,9 +10354,21 @@ SUBROUTINE FAST_UnPackServoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO - i1_l = LBOUND(OutData%xd,1) - i1_u = UBOUND(OutData%xd,1) - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,1) + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_IfW not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%u_IfW)) DEALLOCATE(OutData%u_IfW) + ALLOCATE(OutData%u_IfW(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_IfW.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%u_IfW,1), UBOUND(OutData%u_IfW,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -10230,7 +10402,7 @@ SUBROUTINE FAST_UnPackServoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL SrvD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd + CALL InflowWind_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_IfW(i1), ErrStat2, ErrMsg2 ) ! u_IfW CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -10238,9 +10410,21 @@ SUBROUTINE FAST_UnPackServoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO - i1_l = LBOUND(OutData%z,1) - i1_u = UBOUND(OutData%z,1) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x_SD not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%x_SD)) DEALLOCATE(OutData%x_SD) + ALLOCATE(OutData%x_SD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_SD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%x_SD,1), UBOUND(OutData%x_SD,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -10274,7 +10458,7 @@ SUBROUTINE FAST_UnPackServoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL SrvD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z + CALL SD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x_SD(i1), ErrStat2, ErrMsg2 ) ! x_SD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -10282,9 +10466,21 @@ SUBROUTINE FAST_UnPackServoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO - i1_l = LBOUND(OutData%OtherSt,1) - i1_u = UBOUND(OutData%OtherSt,1) - DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,1) + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xd_SD not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%xd_SD)) DEALLOCATE(OutData%xd_SD) + ALLOCATE(OutData%xd_SD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_SD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%xd_SD,1), UBOUND(OutData%xd_SD,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -10318,7 +10514,7 @@ SUBROUTINE FAST_UnPackServoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL SrvD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt + CALL SD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd_SD(i1), ErrStat2, ErrMsg2 ) ! xd_SD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -10326,6 +10522,21 @@ SUBROUTINE FAST_UnPackServoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z_SD not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%z_SD)) DEALLOCATE(OutData%z_SD) + ALLOCATE(OutData%z_SD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_SD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%z_SD,1), UBOUND(OutData%z_SD,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -10359,13 +10570,29 @@ SUBROUTINE FAST_UnPackServoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL SrvD_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p + CALL SD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z_SD(i1), ErrStat2, ErrMsg2 ) ! z_SD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OtherSt_SD not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%OtherSt_SD)) DEALLOCATE(OutData%OtherSt_SD) + ALLOCATE(OutData%OtherSt_SD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_SD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%OtherSt_SD,1), UBOUND(OutData%OtherSt_SD,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -10399,13 +10626,29 @@ SUBROUTINE FAST_UnPackServoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL SrvD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u + CALL SD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_SD(i1), ErrStat2, ErrMsg2 ) ! OtherSt_SD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_SD not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%u_SD)) DEALLOCATE(OutData%u_SD) + ALLOCATE(OutData%u_SD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_SD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%u_SD,1), UBOUND(OutData%u_SD,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -10439,13 +10682,29 @@ SUBROUTINE FAST_UnPackServoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL SrvD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y + CALL SD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_SD(i1), ErrStat2, ErrMsg2 ) ! u_SD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x_ExtPtfm not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%x_ExtPtfm)) DEALLOCATE(OutData%x_ExtPtfm) + ALLOCATE(OutData%x_ExtPtfm(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_ExtPtfm.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%x_ExtPtfm,1), UBOUND(OutData%x_ExtPtfm,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -10479,27 +10738,29 @@ SUBROUTINE FAST_UnPackServoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL SrvD_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m + CALL ExtPtfm_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x_ExtPtfm(i1), ErrStat2, ErrMsg2 ) ! x_ExtPtfm CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input not allocated + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xd_ExtPtfm not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%xd_ExtPtfm)) DEALLOCATE(OutData%xd_ExtPtfm) + ALLOCATE(OutData%xd_ExtPtfm(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_ExtPtfm.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,1) + DO i1 = LBOUND(OutData%xd_ExtPtfm,1), UBOUND(OutData%xd_ExtPtfm,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -10533,7 +10794,7 @@ SUBROUTINE FAST_UnPackServoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL SrvD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input + CALL ExtPtfm_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd_ExtPtfm(i1), ErrStat2, ErrMsg2 ) ! xd_ExtPtfm CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -10542,703 +10803,412 @@ SUBROUTINE FAST_UnPackServoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z_ExtPtfm not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%z_ExtPtfm)) DEALLOCATE(OutData%z_ExtPtfm) + ALLOCATE(OutData%z_ExtPtfm(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_ExtPtfm.', ErrStat, ErrMsg,RoutineName) RETURN END IF - mask1 = .TRUE. - IF (SIZE(OutData%InputTimes)>0) OutData%InputTimes = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%InputTimes))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%InputTimes) - DEALLOCATE(mask1) - END IF - END SUBROUTINE FAST_UnPackServoDyn_Data - - SUBROUTINE FAST_CopyAeroDyn14_Data( SrcAeroDyn14_DataData, DstAeroDyn14_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AeroDyn14_Data), INTENT(INOUT) :: SrcAeroDyn14_DataData - TYPE(AeroDyn14_Data), INTENT(INOUT) :: DstAeroDyn14_DataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyAeroDyn14_Data' -! - ErrStat = ErrID_None - ErrMsg = "" - DO i1 = LBOUND(SrcAeroDyn14_DataData%x,1), UBOUND(SrcAeroDyn14_DataData%x,1) - CALL AD14_CopyContState( SrcAeroDyn14_DataData%x(i1), DstAeroDyn14_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcAeroDyn14_DataData%xd,1), UBOUND(SrcAeroDyn14_DataData%xd,1) - CALL AD14_CopyDiscState( SrcAeroDyn14_DataData%xd(i1), DstAeroDyn14_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcAeroDyn14_DataData%z,1), UBOUND(SrcAeroDyn14_DataData%z,1) - CALL AD14_CopyConstrState( SrcAeroDyn14_DataData%z(i1), DstAeroDyn14_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcAeroDyn14_DataData%OtherSt,1), UBOUND(SrcAeroDyn14_DataData%OtherSt,1) - CALL AD14_CopyOtherState( SrcAeroDyn14_DataData%OtherSt(i1), DstAeroDyn14_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL AD14_CopyParam( SrcAeroDyn14_DataData%p, DstAeroDyn14_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_CopyInput( SrcAeroDyn14_DataData%u, DstAeroDyn14_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_CopyOutput( SrcAeroDyn14_DataData%y, DstAeroDyn14_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD14_CopyMisc( SrcAeroDyn14_DataData%m, DstAeroDyn14_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcAeroDyn14_DataData%Input)) THEN - i1_l = LBOUND(SrcAeroDyn14_DataData%Input,1) - i1_u = UBOUND(SrcAeroDyn14_DataData%Input,1) - IF (.NOT. ALLOCATED(DstAeroDyn14_DataData%Input)) THEN - ALLOCATE(DstAeroDyn14_DataData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn14_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcAeroDyn14_DataData%Input,1), UBOUND(SrcAeroDyn14_DataData%Input,1) - CALL AD14_CopyInput( SrcAeroDyn14_DataData%Input(i1), DstAeroDyn14_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcAeroDyn14_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcAeroDyn14_DataData%InputTimes,1) - i1_u = UBOUND(SrcAeroDyn14_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstAeroDyn14_DataData%InputTimes)) THEN - ALLOCATE(DstAeroDyn14_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn14_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstAeroDyn14_DataData%InputTimes = SrcAeroDyn14_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyAeroDyn14_Data - - SUBROUTINE FAST_DestroyAeroDyn14_Data( AeroDyn14_DataData, ErrStat, ErrMsg ) - TYPE(AeroDyn14_Data), INTENT(INOUT) :: AeroDyn14_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyAeroDyn14_Data' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -DO i1 = LBOUND(AeroDyn14_DataData%x,1), UBOUND(AeroDyn14_DataData%x,1) - CALL AD14_DestroyContState( AeroDyn14_DataData%x(i1), ErrStat, ErrMsg ) -ENDDO -DO i1 = LBOUND(AeroDyn14_DataData%xd,1), UBOUND(AeroDyn14_DataData%xd,1) - CALL AD14_DestroyDiscState( AeroDyn14_DataData%xd(i1), ErrStat, ErrMsg ) -ENDDO -DO i1 = LBOUND(AeroDyn14_DataData%z,1), UBOUND(AeroDyn14_DataData%z,1) - CALL AD14_DestroyConstrState( AeroDyn14_DataData%z(i1), ErrStat, ErrMsg ) -ENDDO -DO i1 = LBOUND(AeroDyn14_DataData%OtherSt,1), UBOUND(AeroDyn14_DataData%OtherSt,1) - CALL AD14_DestroyOtherState( AeroDyn14_DataData%OtherSt(i1), ErrStat, ErrMsg ) -ENDDO - CALL AD14_DestroyParam( AeroDyn14_DataData%p, ErrStat, ErrMsg ) - CALL AD14_DestroyInput( AeroDyn14_DataData%u, ErrStat, ErrMsg ) - CALL AD14_DestroyOutput( AeroDyn14_DataData%y, ErrStat, ErrMsg ) - CALL AD14_DestroyMisc( AeroDyn14_DataData%m, ErrStat, ErrMsg ) -IF (ALLOCATED(AeroDyn14_DataData%Input)) THEN -DO i1 = LBOUND(AeroDyn14_DataData%Input,1), UBOUND(AeroDyn14_DataData%Input,1) - CALL AD14_DestroyInput( AeroDyn14_DataData%Input(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(AeroDyn14_DataData%Input) -ENDIF -IF (ALLOCATED(AeroDyn14_DataData%InputTimes)) THEN - DEALLOCATE(AeroDyn14_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroyAeroDyn14_Data - - SUBROUTINE FAST_PackAeroDyn14_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AeroDyn14_Data), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackAeroDyn14_Data' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL AD14_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + DO i1 = LBOUND(OutData%z_ExtPtfm,1), UBOUND(OutData%z_ExtPtfm,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL AD14_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd + CALL ExtPtfm_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z_ExtPtfm(i1), ErrStat2, ErrMsg2 ) ! z_ExtPtfm CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL AD14_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OtherSt_ExtPtfm not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%OtherSt_ExtPtfm)) DEALLOCATE(OutData%OtherSt_ExtPtfm) + ALLOCATE(OutData%OtherSt_ExtPtfm(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_ExtPtfm.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%OtherSt_ExtPtfm,1), UBOUND(OutData%OtherSt_ExtPtfm,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL AD14_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt + CALL ExtPtfm_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_ExtPtfm(i1), ErrStat2, ErrMsg2 ) ! OtherSt_ExtPtfm CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL AD14_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_ExtPtfm not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%u_ExtPtfm)) DEALLOCATE(OutData%u_ExtPtfm) + ALLOCATE(OutData%u_ExtPtfm(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_ExtPtfm.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%u_ExtPtfm,1), UBOUND(OutData%u_ExtPtfm,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL AD14_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u + CALL ExtPtfm_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_ExtPtfm(i1), ErrStat2, ErrMsg2 ) ! u_ExtPtfm CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x_HD not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%x_HD)) DEALLOCATE(OutData%x_HD) + ALLOCATE(OutData%x_HD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_HD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%x_HD,1), UBOUND(OutData%x_HD,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL AD14_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y + CALL HydroDyn_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x_HD(i1), ErrStat2, ErrMsg2 ) ! x_HD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xd_HD not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%xd_HD)) DEALLOCATE(OutData%xd_HD) + ALLOCATE(OutData%xd_HD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_HD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%xd_HD,1), UBOUND(OutData%xd_HD,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL AD14_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m + CALL HydroDyn_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd_HD(i1), ErrStat2, ErrMsg2 ) ! xd_HD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z_HD not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%z_HD)) DEALLOCATE(OutData%z_HD) + ALLOCATE(OutData%z_HD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_HD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%z_HD,1), UBOUND(OutData%z_HD,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL AD14_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input + CALL HydroDyn_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z_HD(i1), ErrStat2, ErrMsg2 ) ! z_HD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! Input - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no - IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL AD14_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL AD14_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL AD14_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL AD14_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - CALL AD14_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AD14_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AD14_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AD14_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%Input) ) THEN - IntKiBuf( Int_Xferred ) = 0 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OtherSt_HD not allocated Int_Xferred = Int_Xferred + 1 ELSE - IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL AD14_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input + IF (ALLOCATED(OutData%OtherSt_HD)) DEALLOCATE(OutData%OtherSt_HD) + ALLOCATE(OutData%OtherSt_HD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_HD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%OtherSt_HD,1), UBOUND(OutData%OtherSt_HD,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL HydroDyn_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_HD(i1), ErrStat2, ErrMsg2 ) ! OtherSt_HD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-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(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - IF ( .NOT. ALLOCATED(InData%InputTimes) ) THEN - IntKiBuf( Int_Xferred ) = 0 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_HD not allocated Int_Xferred = Int_Xferred + 1 ELSE - IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%InputTimes)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%InputTimes))-1 ) = PACK(InData%InputTimes,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%InputTimes) - END IF - END SUBROUTINE FAST_PackAeroDyn14_Data - - SUBROUTINE FAST_UnPackAeroDyn14_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AeroDyn14_Data), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackAeroDyn14_Data' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - i1_l = LBOUND(OutData%x,1) - i1_u = UBOUND(OutData%x,1) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) + IF (ALLOCATED(OutData%u_HD)) DEALLOCATE(OutData%u_HD) + ALLOCATE(OutData%u_HD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_HD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%u_HD,1), UBOUND(OutData%u_HD,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -11272,7 +11242,7 @@ SUBROUTINE FAST_UnPackAeroDyn14_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD14_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x + CALL HydroDyn_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_HD(i1), ErrStat2, ErrMsg2 ) ! u_HD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -11280,9 +11250,21 @@ SUBROUTINE FAST_UnPackAeroDyn14_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO - i1_l = LBOUND(OutData%xd,1) - i1_u = UBOUND(OutData%xd,1) - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,1) + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x_IceF not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%x_IceF)) DEALLOCATE(OutData%x_IceF) + ALLOCATE(OutData%x_IceF(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_IceF.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%x_IceF,1), UBOUND(OutData%x_IceF,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -11316,7 +11298,7 @@ SUBROUTINE FAST_UnPackAeroDyn14_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD14_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd + CALL IceFloe_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x_IceF(i1), ErrStat2, ErrMsg2 ) ! x_IceF CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -11324,9 +11306,21 @@ SUBROUTINE FAST_UnPackAeroDyn14_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO - i1_l = LBOUND(OutData%z,1) - i1_u = UBOUND(OutData%z,1) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xd_IceF not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%xd_IceF)) DEALLOCATE(OutData%xd_IceF) + ALLOCATE(OutData%xd_IceF(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_IceF.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%xd_IceF,1), UBOUND(OutData%xd_IceF,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -11360,7 +11354,7 @@ SUBROUTINE FAST_UnPackAeroDyn14_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD14_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z + CALL IceFloe_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd_IceF(i1), ErrStat2, ErrMsg2 ) ! xd_IceF CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -11368,9 +11362,21 @@ SUBROUTINE FAST_UnPackAeroDyn14_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO - i1_l = LBOUND(OutData%OtherSt,1) - i1_u = UBOUND(OutData%OtherSt,1) - DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,1) + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z_IceF not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%z_IceF)) DEALLOCATE(OutData%z_IceF) + ALLOCATE(OutData%z_IceF(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_IceF.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%z_IceF,1), UBOUND(OutData%z_IceF,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -11404,7 +11410,7 @@ SUBROUTINE FAST_UnPackAeroDyn14_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD14_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt + CALL IceFloe_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z_IceF(i1), ErrStat2, ErrMsg2 ) ! z_IceF CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -11412,6 +11418,21 @@ SUBROUTINE FAST_UnPackAeroDyn14_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OtherSt_IceF not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%OtherSt_IceF)) DEALLOCATE(OutData%OtherSt_IceF) + ALLOCATE(OutData%OtherSt_IceF(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_IceF.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%OtherSt_IceF,1), UBOUND(OutData%OtherSt_IceF,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -11445,13 +11466,29 @@ SUBROUTINE FAST_UnPackAeroDyn14_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD14_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p + CALL IceFloe_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_IceF(i1), ErrStat2, ErrMsg2 ) ! OtherSt_IceF CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_IceF not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%u_IceF)) DEALLOCATE(OutData%u_IceF) + ALLOCATE(OutData%u_IceF(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_IceF.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%u_IceF,1), UBOUND(OutData%u_IceF,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -11485,13 +11522,29 @@ SUBROUTINE FAST_UnPackAeroDyn14_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD14_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u + CALL IceFloe_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_IceF(i1), ErrStat2, ErrMsg2 ) ! u_IceF CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x_MAP not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%x_MAP)) DEALLOCATE(OutData%x_MAP) + ALLOCATE(OutData%x_MAP(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_MAP.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%x_MAP,1), UBOUND(OutData%x_MAP,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -11525,13 +11578,29 @@ SUBROUTINE FAST_UnPackAeroDyn14_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD14_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y + CALL MAP_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x_MAP(i1), ErrStat2, ErrMsg2 ) ! x_MAP CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xd_MAP not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%xd_MAP)) DEALLOCATE(OutData%xd_MAP) + ALLOCATE(OutData%xd_MAP(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_MAP.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%xd_MAP,1), UBOUND(OutData%xd_MAP,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -11565,27 +11634,29 @@ SUBROUTINE FAST_UnPackAeroDyn14_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD14_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m + CALL MAP_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd_MAP(i1), ErrStat2, ErrMsg2 ) ! xd_MAP CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input not allocated + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z_MAP not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%z_MAP)) DEALLOCATE(OutData%z_MAP) + ALLOCATE(OutData%z_MAP(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_MAP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,1) + DO i1 = LBOUND(OutData%z_MAP,1), UBOUND(OutData%z_MAP,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -11619,7 +11690,7 @@ SUBROUTINE FAST_UnPackAeroDyn14_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD14_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input + CALL MAP_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z_MAP(i1), ErrStat2, ErrMsg2 ) ! z_MAP CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -11628,703 +11699,412 @@ SUBROUTINE FAST_UnPackAeroDyn14_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes not allocated + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_MAP not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%u_MAP)) DEALLOCATE(OutData%u_MAP) + ALLOCATE(OutData%u_MAP(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_MAP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - mask1 = .TRUE. - IF (SIZE(OutData%InputTimes)>0) OutData%InputTimes = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%InputTimes))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%InputTimes) - DEALLOCATE(mask1) - END IF - END SUBROUTINE FAST_UnPackAeroDyn14_Data - - SUBROUTINE FAST_CopyAeroDyn_Data( SrcAeroDyn_DataData, DstAeroDyn_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(AeroDyn_Data), INTENT(INOUT) :: SrcAeroDyn_DataData - TYPE(AeroDyn_Data), INTENT(INOUT) :: DstAeroDyn_DataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyAeroDyn_Data' -! - ErrStat = ErrID_None - ErrMsg = "" - DO i1 = LBOUND(SrcAeroDyn_DataData%x,1), UBOUND(SrcAeroDyn_DataData%x,1) - CALL AD_CopyContState( SrcAeroDyn_DataData%x(i1), DstAeroDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcAeroDyn_DataData%xd,1), UBOUND(SrcAeroDyn_DataData%xd,1) - CALL AD_CopyDiscState( SrcAeroDyn_DataData%xd(i1), DstAeroDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcAeroDyn_DataData%z,1), UBOUND(SrcAeroDyn_DataData%z,1) - CALL AD_CopyConstrState( SrcAeroDyn_DataData%z(i1), DstAeroDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcAeroDyn_DataData%OtherSt,1), UBOUND(SrcAeroDyn_DataData%OtherSt,1) - CALL AD_CopyOtherState( SrcAeroDyn_DataData%OtherSt(i1), DstAeroDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL AD_CopyParam( SrcAeroDyn_DataData%p, DstAeroDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD_CopyInput( SrcAeroDyn_DataData%u, DstAeroDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD_CopyOutput( SrcAeroDyn_DataData%y, DstAeroDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL AD_CopyMisc( SrcAeroDyn_DataData%m, DstAeroDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcAeroDyn_DataData%Input)) THEN - i1_l = LBOUND(SrcAeroDyn_DataData%Input,1) - i1_u = UBOUND(SrcAeroDyn_DataData%Input,1) - IF (.NOT. ALLOCATED(DstAeroDyn_DataData%Input)) THEN - ALLOCATE(DstAeroDyn_DataData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcAeroDyn_DataData%Input,1), UBOUND(SrcAeroDyn_DataData%Input,1) - CALL AD_CopyInput( SrcAeroDyn_DataData%Input(i1), DstAeroDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcAeroDyn_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcAeroDyn_DataData%InputTimes,1) - i1_u = UBOUND(SrcAeroDyn_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstAeroDyn_DataData%InputTimes)) THEN - ALLOCATE(DstAeroDyn_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstAeroDyn_DataData%InputTimes = SrcAeroDyn_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyAeroDyn_Data - - SUBROUTINE FAST_DestroyAeroDyn_Data( AeroDyn_DataData, ErrStat, ErrMsg ) - TYPE(AeroDyn_Data), INTENT(INOUT) :: AeroDyn_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyAeroDyn_Data' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -DO i1 = LBOUND(AeroDyn_DataData%x,1), UBOUND(AeroDyn_DataData%x,1) - CALL AD_DestroyContState( AeroDyn_DataData%x(i1), ErrStat, ErrMsg ) -ENDDO -DO i1 = LBOUND(AeroDyn_DataData%xd,1), UBOUND(AeroDyn_DataData%xd,1) - CALL AD_DestroyDiscState( AeroDyn_DataData%xd(i1), ErrStat, ErrMsg ) -ENDDO -DO i1 = LBOUND(AeroDyn_DataData%z,1), UBOUND(AeroDyn_DataData%z,1) - CALL AD_DestroyConstrState( AeroDyn_DataData%z(i1), ErrStat, ErrMsg ) -ENDDO -DO i1 = LBOUND(AeroDyn_DataData%OtherSt,1), UBOUND(AeroDyn_DataData%OtherSt,1) - CALL AD_DestroyOtherState( AeroDyn_DataData%OtherSt(i1), ErrStat, ErrMsg ) -ENDDO - CALL AD_DestroyParam( AeroDyn_DataData%p, ErrStat, ErrMsg ) - CALL AD_DestroyInput( AeroDyn_DataData%u, ErrStat, ErrMsg ) - CALL AD_DestroyOutput( AeroDyn_DataData%y, ErrStat, ErrMsg ) - CALL AD_DestroyMisc( AeroDyn_DataData%m, ErrStat, ErrMsg ) -IF (ALLOCATED(AeroDyn_DataData%Input)) THEN -DO i1 = LBOUND(AeroDyn_DataData%Input,1), UBOUND(AeroDyn_DataData%Input,1) - CALL AD_DestroyInput( AeroDyn_DataData%Input(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(AeroDyn_DataData%Input) -ENDIF -IF (ALLOCATED(AeroDyn_DataData%InputTimes)) THEN - DEALLOCATE(AeroDyn_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroyAeroDyn_Data - - SUBROUTINE FAST_PackAeroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(AeroDyn_Data), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackAeroDyn_Data' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL AD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + DO i1 = LBOUND(OutData%u_MAP,1), UBOUND(OutData%u_MAP,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL AD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd + CALL MAP_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_MAP(i1), ErrStat2, ErrMsg2 ) ! u_MAP CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x_FEAM not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%x_FEAM)) DEALLOCATE(OutData%x_FEAM) + ALLOCATE(OutData%x_FEAM(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_FEAM.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%x_FEAM,1), UBOUND(OutData%x_FEAM,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL AD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z + CALL FEAM_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x_FEAM(i1), ErrStat2, ErrMsg2 ) ! x_FEAM CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xd_FEAM not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%xd_FEAM)) DEALLOCATE(OutData%xd_FEAM) + ALLOCATE(OutData%xd_FEAM(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_FEAM.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%xd_FEAM,1), UBOUND(OutData%xd_FEAM,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL AD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt + CALL FEAM_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd_FEAM(i1), ErrStat2, ErrMsg2 ) ! xd_FEAM CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z_FEAM not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%z_FEAM)) DEALLOCATE(OutData%z_FEAM) + ALLOCATE(OutData%z_FEAM(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_FEAM.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%z_FEAM,1), UBOUND(OutData%z_FEAM,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - END DO - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL AD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p + CALL FEAM_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z_FEAM(i1), ErrStat2, ErrMsg2 ) ! z_FEAM CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OtherSt_FEAM not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%OtherSt_FEAM)) DEALLOCATE(OutData%OtherSt_FEAM) + ALLOCATE(OutData%OtherSt_FEAM(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_FEAM.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%OtherSt_FEAM,1), UBOUND(OutData%OtherSt_FEAM,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL AD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u + CALL FEAM_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_FEAM(i1), ErrStat2, ErrMsg2 ) ! OtherSt_FEAM CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_FEAM not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%u_FEAM)) DEALLOCATE(OutData%u_FEAM) + ALLOCATE(OutData%u_FEAM(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_FEAM.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%u_FEAM,1), UBOUND(OutData%u_FEAM,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL AD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y + CALL FEAM_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_FEAM(i1), ErrStat2, ErrMsg2 ) ! u_FEAM CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x_MD not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%x_MD)) DEALLOCATE(OutData%x_MD) + ALLOCATE(OutData%x_MD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x_MD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%x_MD,1), UBOUND(OutData%x_MD,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL AD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m + CALL MD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x_MD(i1), ErrStat2, ErrMsg2 ) ! x_MD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL AD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Input - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no - IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL AD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL AD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL AD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL AD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - CALL AD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL AD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%Input) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL AD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - IF ( .NOT. ALLOCATED(InData%InputTimes) ) THEN - IntKiBuf( Int_Xferred ) = 0 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xd_MD not allocated Int_Xferred = Int_Xferred + 1 ELSE - IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%InputTimes)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%InputTimes))-1 ) = PACK(InData%InputTimes,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%InputTimes) - END IF - END SUBROUTINE FAST_PackAeroDyn_Data - - SUBROUTINE FAST_UnPackAeroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(AeroDyn_Data), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackAeroDyn_Data' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - i1_l = LBOUND(OutData%x,1) - i1_u = UBOUND(OutData%x,1) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) + IF (ALLOCATED(OutData%xd_MD)) DEALLOCATE(OutData%xd_MD) + ALLOCATE(OutData%xd_MD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_MD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%xd_MD,1), UBOUND(OutData%xd_MD,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -12358,7 +12138,7 @@ SUBROUTINE FAST_UnPackAeroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x + CALL MD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd_MD(i1), ErrStat2, ErrMsg2 ) ! xd_MD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -12366,9 +12146,21 @@ SUBROUTINE FAST_UnPackAeroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO - i1_l = LBOUND(OutData%xd,1) - i1_u = UBOUND(OutData%xd,1) - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,1) + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z_MD not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%z_MD)) DEALLOCATE(OutData%z_MD) + ALLOCATE(OutData%z_MD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z_MD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%z_MD,1), UBOUND(OutData%z_MD,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -12402,7 +12194,7 @@ SUBROUTINE FAST_UnPackAeroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd + CALL MD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z_MD(i1), ErrStat2, ErrMsg2 ) ! z_MD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -12410,9 +12202,21 @@ SUBROUTINE FAST_UnPackAeroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO - i1_l = LBOUND(OutData%z,1) - i1_u = UBOUND(OutData%z,1) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OtherSt_MD not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%OtherSt_MD)) DEALLOCATE(OutData%OtherSt_MD) + ALLOCATE(OutData%OtherSt_MD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt_MD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%OtherSt_MD,1), UBOUND(OutData%OtherSt_MD,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -12446,7 +12250,7 @@ SUBROUTINE FAST_UnPackAeroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z + CALL MD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_MD(i1), ErrStat2, ErrMsg2 ) ! OtherSt_MD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -12454,9 +12258,21 @@ SUBROUTINE FAST_UnPackAeroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO - i1_l = LBOUND(OutData%OtherSt,1) - i1_u = UBOUND(OutData%OtherSt,1) - DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,1) + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_MD not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%u_MD)) DEALLOCATE(OutData%u_MD) + ALLOCATE(OutData%u_MD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_MD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%u_MD,1), UBOUND(OutData%u_MD,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -12490,7 +12306,7 @@ SUBROUTINE FAST_UnPackAeroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL AD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt + CALL MD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u_MD(i1), ErrStat2, ErrMsg2 ) ! u_MD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -12498,1626 +12314,1162 @@ SUBROUTINE FAST_UnPackAeroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + END IF + END SUBROUTINE FAST_UnPackLinStateSave - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL AD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%InputTimes)>0) OutData%InputTimes = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%InputTimes))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%InputTimes) - DEALLOCATE(mask1) - END IF - END SUBROUTINE FAST_UnPackAeroDyn_Data - - SUBROUTINE FAST_CopyInflowWind_Data( SrcInflowWind_DataData, DstInflowWind_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(InflowWind_Data), INTENT(IN) :: SrcInflowWind_DataData - TYPE(InflowWind_Data), INTENT(INOUT) :: DstInflowWind_DataData + SUBROUTINE FAST_CopyLinType( SrcLinTypeData, DstLinTypeData, CtrlCode, ErrStat, ErrMsg ) + TYPE(FAST_LinType), INTENT(IN) :: SrcLinTypeData + TYPE(FAST_LinType), INTENT(INOUT) :: DstLinTypeData INTEGER(IntKi), INTENT(IN ) :: CtrlCode INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local INTEGER(IntKi) :: i,j,k INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyInflowWind_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyLinType' ! ErrStat = ErrID_None ErrMsg = "" - DO i1 = LBOUND(SrcInflowWind_DataData%x,1), UBOUND(SrcInflowWind_DataData%x,1) - CALL InflowWind_CopyContState( SrcInflowWind_DataData%x(i1), DstInflowWind_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcInflowWind_DataData%xd,1), UBOUND(SrcInflowWind_DataData%xd,1) - CALL InflowWind_CopyDiscState( SrcInflowWind_DataData%xd(i1), DstInflowWind_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcInflowWind_DataData%z,1), UBOUND(SrcInflowWind_DataData%z,1) - CALL InflowWind_CopyConstrState( SrcInflowWind_DataData%z(i1), DstInflowWind_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcInflowWind_DataData%OtherSt,1), UBOUND(SrcInflowWind_DataData%OtherSt,1) - CALL InflowWind_CopyOtherState( SrcInflowWind_DataData%OtherSt(i1), DstInflowWind_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL InflowWind_CopyParam( SrcInflowWind_DataData%p, DstInflowWind_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_CopyInput( SrcInflowWind_DataData%u, DstInflowWind_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_CopyOutput( SrcInflowWind_DataData%y, DstInflowWind_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL InflowWind_CopyMisc( SrcInflowWind_DataData%m, DstInflowWind_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcInflowWind_DataData%Input)) THEN - i1_l = LBOUND(SrcInflowWind_DataData%Input,1) - i1_u = UBOUND(SrcInflowWind_DataData%Input,1) - IF (.NOT. ALLOCATED(DstInflowWind_DataData%Input)) THEN - ALLOCATE(DstInflowWind_DataData%Input(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcLinTypeData%Names_u)) THEN + i1_l = LBOUND(SrcLinTypeData%Names_u,1) + i1_u = UBOUND(SrcLinTypeData%Names_u,1) + IF (.NOT. ALLOCATED(DstLinTypeData%Names_u)) THEN + ALLOCATE(DstLinTypeData%Names_u(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInflowWind_DataData%Input.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DO i1 = LBOUND(SrcInflowWind_DataData%Input,1), UBOUND(SrcInflowWind_DataData%Input,1) - CALL InflowWind_CopyInput( SrcInflowWind_DataData%Input(i1), DstInflowWind_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO + DstLinTypeData%Names_u = SrcLinTypeData%Names_u ENDIF -IF (ALLOCATED(SrcInflowWind_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcInflowWind_DataData%InputTimes,1) - i1_u = UBOUND(SrcInflowWind_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstInflowWind_DataData%InputTimes)) THEN - ALLOCATE(DstInflowWind_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcLinTypeData%Names_y)) THEN + i1_l = LBOUND(SrcLinTypeData%Names_y,1) + i1_u = UBOUND(SrcLinTypeData%Names_y,1) + IF (.NOT. ALLOCATED(DstLinTypeData%Names_y)) THEN + ALLOCATE(DstLinTypeData%Names_y(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInflowWind_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_y.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstInflowWind_DataData%InputTimes = SrcInflowWind_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopyInflowWind_Data - - SUBROUTINE FAST_DestroyInflowWind_Data( InflowWind_DataData, ErrStat, ErrMsg ) - TYPE(InflowWind_Data), INTENT(INOUT) :: InflowWind_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyInflowWind_Data' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" -DO i1 = LBOUND(InflowWind_DataData%x,1), UBOUND(InflowWind_DataData%x,1) - CALL InflowWind_DestroyContState( InflowWind_DataData%x(i1), ErrStat, ErrMsg ) -ENDDO -DO i1 = LBOUND(InflowWind_DataData%xd,1), UBOUND(InflowWind_DataData%xd,1) - CALL InflowWind_DestroyDiscState( InflowWind_DataData%xd(i1), ErrStat, ErrMsg ) -ENDDO -DO i1 = LBOUND(InflowWind_DataData%z,1), UBOUND(InflowWind_DataData%z,1) - CALL InflowWind_DestroyConstrState( InflowWind_DataData%z(i1), ErrStat, ErrMsg ) -ENDDO -DO i1 = LBOUND(InflowWind_DataData%OtherSt,1), UBOUND(InflowWind_DataData%OtherSt,1) - CALL InflowWind_DestroyOtherState( InflowWind_DataData%OtherSt(i1), ErrStat, ErrMsg ) -ENDDO - CALL InflowWind_DestroyParam( InflowWind_DataData%p, ErrStat, ErrMsg ) - CALL InflowWind_DestroyInput( InflowWind_DataData%u, ErrStat, ErrMsg ) - CALL InflowWind_DestroyOutput( InflowWind_DataData%y, ErrStat, ErrMsg ) - CALL InflowWind_DestroyMisc( InflowWind_DataData%m, ErrStat, ErrMsg ) -IF (ALLOCATED(InflowWind_DataData%Input)) THEN -DO i1 = LBOUND(InflowWind_DataData%Input,1), UBOUND(InflowWind_DataData%Input,1) - CALL InflowWind_DestroyInput( InflowWind_DataData%Input(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(InflowWind_DataData%Input) + DstLinTypeData%Names_y = SrcLinTypeData%Names_y ENDIF -IF (ALLOCATED(InflowWind_DataData%InputTimes)) THEN - DEALLOCATE(InflowWind_DataData%InputTimes) +IF (ALLOCATED(SrcLinTypeData%Names_x)) THEN + i1_l = LBOUND(SrcLinTypeData%Names_x,1) + i1_u = UBOUND(SrcLinTypeData%Names_x,1) + IF (.NOT. ALLOCATED(DstLinTypeData%Names_x)) THEN + ALLOCATE(DstLinTypeData%Names_x(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_x.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstLinTypeData%Names_x = SrcLinTypeData%Names_x ENDIF - END SUBROUTINE FAST_DestroyInflowWind_Data - - SUBROUTINE FAST_PackInflowWind_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(InflowWind_Data), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackInflowWind_Data' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL InflowWind_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL InflowWind_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL InflowWind_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL InflowWind_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL InflowWind_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL InflowWind_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Input - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO +IF (ALLOCATED(SrcLinTypeData%Names_xd)) THEN + i1_l = LBOUND(SrcLinTypeData%Names_xd,1) + i1_u = UBOUND(SrcLinTypeData%Names_xd,1) + IF (.NOT. ALLOCATED(DstLinTypeData%Names_xd)) THEN + ALLOCATE(DstLinTypeData%Names_xd(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_xd.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no - IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes + DstLinTypeData%Names_xd = SrcLinTypeData%Names_xd +ENDIF +IF (ALLOCATED(SrcLinTypeData%Names_z)) THEN + i1_l = LBOUND(SrcLinTypeData%Names_z,1) + i1_u = UBOUND(SrcLinTypeData%Names_z,1) + IF (.NOT. ALLOCATED(DstLinTypeData%Names_z)) THEN + ALLOCATE(DstLinTypeData%Names_z(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Names_z.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF + DstLinTypeData%Names_z = SrcLinTypeData%Names_z +ENDIF +IF (ALLOCATED(SrcLinTypeData%op_u)) THEN + i1_l = LBOUND(SrcLinTypeData%op_u,1) + i1_u = UBOUND(SrcLinTypeData%op_u,1) + IF (.NOT. ALLOCATED(DstLinTypeData%op_u)) THEN + ALLOCATE(DstLinTypeData%op_u(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_u.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF + DstLinTypeData%op_u = SrcLinTypeData%op_u +ENDIF +IF (ALLOCATED(SrcLinTypeData%op_y)) THEN + i1_l = LBOUND(SrcLinTypeData%op_y,1) + i1_u = UBOUND(SrcLinTypeData%op_y,1) + IF (.NOT. ALLOCATED(DstLinTypeData%op_y)) THEN + ALLOCATE(DstLinTypeData%op_y(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_y.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF + DstLinTypeData%op_y = SrcLinTypeData%op_y +ENDIF +IF (ALLOCATED(SrcLinTypeData%op_x)) THEN + i1_l = LBOUND(SrcLinTypeData%op_x,1) + i1_u = UBOUND(SrcLinTypeData%op_x,1) + IF (.NOT. ALLOCATED(DstLinTypeData%op_x)) THEN + ALLOCATE(DstLinTypeData%op_x(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_x.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL InflowWind_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL InflowWind_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + DstLinTypeData%op_x = SrcLinTypeData%op_x +ENDIF +IF (ALLOCATED(SrcLinTypeData%op_dx)) THEN + i1_l = LBOUND(SrcLinTypeData%op_dx,1) + i1_u = UBOUND(SrcLinTypeData%op_dx,1) + IF (.NOT. ALLOCATED(DstLinTypeData%op_dx)) THEN + ALLOCATE(DstLinTypeData%op_dx(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_dx.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstLinTypeData%op_dx = SrcLinTypeData%op_dx +ENDIF +IF (ALLOCATED(SrcLinTypeData%op_xd)) THEN + i1_l = LBOUND(SrcLinTypeData%op_xd,1) + i1_u = UBOUND(SrcLinTypeData%op_xd,1) + IF (.NOT. ALLOCATED(DstLinTypeData%op_xd)) THEN + ALLOCATE(DstLinTypeData%op_xd(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_xd.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstLinTypeData%op_xd = SrcLinTypeData%op_xd +ENDIF +IF (ALLOCATED(SrcLinTypeData%op_z)) THEN + i1_l = LBOUND(SrcLinTypeData%op_z,1) + i1_u = UBOUND(SrcLinTypeData%op_z,1) + IF (.NOT. ALLOCATED(DstLinTypeData%op_z)) THEN + ALLOCATE(DstLinTypeData%op_z(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_z.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstLinTypeData%op_z = SrcLinTypeData%op_z +ENDIF +IF (ALLOCATED(SrcLinTypeData%op_x_eig_mag)) THEN + i1_l = LBOUND(SrcLinTypeData%op_x_eig_mag,1) + i1_u = UBOUND(SrcLinTypeData%op_x_eig_mag,1) + IF (.NOT. ALLOCATED(DstLinTypeData%op_x_eig_mag)) THEN + ALLOCATE(DstLinTypeData%op_x_eig_mag(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_x_eig_mag.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstLinTypeData%op_x_eig_mag = SrcLinTypeData%op_x_eig_mag +ENDIF +IF (ALLOCATED(SrcLinTypeData%op_x_eig_phase)) THEN + i1_l = LBOUND(SrcLinTypeData%op_x_eig_phase,1) + i1_u = UBOUND(SrcLinTypeData%op_x_eig_phase,1) + IF (.NOT. ALLOCATED(DstLinTypeData%op_x_eig_phase)) THEN + ALLOCATE(DstLinTypeData%op_x_eig_phase(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%op_x_eig_phase.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstLinTypeData%op_x_eig_phase = SrcLinTypeData%op_x_eig_phase +ENDIF +IF (ALLOCATED(SrcLinTypeData%Use_u)) THEN + i1_l = LBOUND(SrcLinTypeData%Use_u,1) + i1_u = UBOUND(SrcLinTypeData%Use_u,1) + IF (.NOT. ALLOCATED(DstLinTypeData%Use_u)) THEN + ALLOCATE(DstLinTypeData%Use_u(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Use_u.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstLinTypeData%Use_u = SrcLinTypeData%Use_u +ENDIF +IF (ALLOCATED(SrcLinTypeData%Use_y)) THEN + i1_l = LBOUND(SrcLinTypeData%Use_y,1) + i1_u = UBOUND(SrcLinTypeData%Use_y,1) + IF (.NOT. ALLOCATED(DstLinTypeData%Use_y)) THEN + ALLOCATE(DstLinTypeData%Use_y(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%Use_y.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstLinTypeData%Use_y = SrcLinTypeData%Use_y +ENDIF +IF (ALLOCATED(SrcLinTypeData%A)) THEN + i1_l = LBOUND(SrcLinTypeData%A,1) + i1_u = UBOUND(SrcLinTypeData%A,1) + i2_l = LBOUND(SrcLinTypeData%A,2) + i2_u = UBOUND(SrcLinTypeData%A,2) + IF (.NOT. ALLOCATED(DstLinTypeData%A)) THEN + ALLOCATE(DstLinTypeData%A(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%A.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstLinTypeData%A = SrcLinTypeData%A +ENDIF +IF (ALLOCATED(SrcLinTypeData%B)) THEN + i1_l = LBOUND(SrcLinTypeData%B,1) + i1_u = UBOUND(SrcLinTypeData%B,1) + i2_l = LBOUND(SrcLinTypeData%B,2) + i2_u = UBOUND(SrcLinTypeData%B,2) + IF (.NOT. ALLOCATED(DstLinTypeData%B)) THEN + ALLOCATE(DstLinTypeData%B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%B.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstLinTypeData%B = SrcLinTypeData%B +ENDIF +IF (ALLOCATED(SrcLinTypeData%C)) THEN + i1_l = LBOUND(SrcLinTypeData%C,1) + i1_u = UBOUND(SrcLinTypeData%C,1) + i2_l = LBOUND(SrcLinTypeData%C,2) + i2_u = UBOUND(SrcLinTypeData%C,2) + IF (.NOT. ALLOCATED(DstLinTypeData%C)) THEN + ALLOCATE(DstLinTypeData%C(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%C.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstLinTypeData%C = SrcLinTypeData%C +ENDIF +IF (ALLOCATED(SrcLinTypeData%D)) THEN + i1_l = LBOUND(SrcLinTypeData%D,1) + i1_u = UBOUND(SrcLinTypeData%D,1) + i2_l = LBOUND(SrcLinTypeData%D,2) + i2_u = UBOUND(SrcLinTypeData%D,2) + IF (.NOT. ALLOCATED(DstLinTypeData%D)) THEN + ALLOCATE(DstLinTypeData%D(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%D.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstLinTypeData%D = SrcLinTypeData%D +ENDIF +IF (ALLOCATED(SrcLinTypeData%StateRotation)) THEN + i1_l = LBOUND(SrcLinTypeData%StateRotation,1) + i1_u = UBOUND(SrcLinTypeData%StateRotation,1) + i2_l = LBOUND(SrcLinTypeData%StateRotation,2) + i2_u = UBOUND(SrcLinTypeData%StateRotation,2) + IF (.NOT. ALLOCATED(DstLinTypeData%StateRotation)) THEN + ALLOCATE(DstLinTypeData%StateRotation(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%StateRotation.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstLinTypeData%StateRotation = SrcLinTypeData%StateRotation +ENDIF +IF (ALLOCATED(SrcLinTypeData%StateRel_x)) THEN + i1_l = LBOUND(SrcLinTypeData%StateRel_x,1) + i1_u = UBOUND(SrcLinTypeData%StateRel_x,1) + i2_l = LBOUND(SrcLinTypeData%StateRel_x,2) + i2_u = UBOUND(SrcLinTypeData%StateRel_x,2) + IF (.NOT. ALLOCATED(DstLinTypeData%StateRel_x)) THEN + ALLOCATE(DstLinTypeData%StateRel_x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%StateRel_x.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstLinTypeData%StateRel_x = SrcLinTypeData%StateRel_x +ENDIF +IF (ALLOCATED(SrcLinTypeData%StateRel_xdot)) THEN + i1_l = LBOUND(SrcLinTypeData%StateRel_xdot,1) + i1_u = UBOUND(SrcLinTypeData%StateRel_xdot,1) + i2_l = LBOUND(SrcLinTypeData%StateRel_xdot,2) + i2_u = UBOUND(SrcLinTypeData%StateRel_xdot,2) + IF (.NOT. ALLOCATED(DstLinTypeData%StateRel_xdot)) THEN + ALLOCATE(DstLinTypeData%StateRel_xdot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%StateRel_xdot.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstLinTypeData%StateRel_xdot = SrcLinTypeData%StateRel_xdot +ENDIF +IF (ALLOCATED(SrcLinTypeData%IsLoad_u)) THEN + i1_l = LBOUND(SrcLinTypeData%IsLoad_u,1) + i1_u = UBOUND(SrcLinTypeData%IsLoad_u,1) + IF (.NOT. ALLOCATED(DstLinTypeData%IsLoad_u)) THEN + ALLOCATE(DstLinTypeData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstLinTypeData%IsLoad_u = SrcLinTypeData%IsLoad_u +ENDIF +IF (ALLOCATED(SrcLinTypeData%RotFrame_u)) THEN + i1_l = LBOUND(SrcLinTypeData%RotFrame_u,1) + i1_u = UBOUND(SrcLinTypeData%RotFrame_u,1) + IF (.NOT. ALLOCATED(DstLinTypeData%RotFrame_u)) THEN + ALLOCATE(DstLinTypeData%RotFrame_u(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstLinTypeData%RotFrame_u = SrcLinTypeData%RotFrame_u +ENDIF +IF (ALLOCATED(SrcLinTypeData%RotFrame_y)) THEN + i1_l = LBOUND(SrcLinTypeData%RotFrame_y,1) + i1_u = UBOUND(SrcLinTypeData%RotFrame_y,1) + IF (.NOT. ALLOCATED(DstLinTypeData%RotFrame_y)) THEN + ALLOCATE(DstLinTypeData%RotFrame_y(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstLinTypeData%RotFrame_y = SrcLinTypeData%RotFrame_y +ENDIF +IF (ALLOCATED(SrcLinTypeData%RotFrame_x)) THEN + i1_l = LBOUND(SrcLinTypeData%RotFrame_x,1) + i1_u = UBOUND(SrcLinTypeData%RotFrame_x,1) + IF (.NOT. ALLOCATED(DstLinTypeData%RotFrame_x)) THEN + ALLOCATE(DstLinTypeData%RotFrame_x(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%RotFrame_x.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstLinTypeData%RotFrame_x = SrcLinTypeData%RotFrame_x +ENDIF +IF (ALLOCATED(SrcLinTypeData%RotFrame_z)) THEN + i1_l = LBOUND(SrcLinTypeData%RotFrame_z,1) + i1_u = UBOUND(SrcLinTypeData%RotFrame_z,1) + IF (.NOT. ALLOCATED(DstLinTypeData%RotFrame_z)) THEN + ALLOCATE(DstLinTypeData%RotFrame_z(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%RotFrame_z.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstLinTypeData%RotFrame_z = SrcLinTypeData%RotFrame_z +ENDIF +IF (ALLOCATED(SrcLinTypeData%DerivOrder_x)) THEN + i1_l = LBOUND(SrcLinTypeData%DerivOrder_x,1) + i1_u = UBOUND(SrcLinTypeData%DerivOrder_x,1) + IF (.NOT. ALLOCATED(DstLinTypeData%DerivOrder_x)) THEN + ALLOCATE(DstLinTypeData%DerivOrder_x(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstLinTypeData%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstLinTypeData%DerivOrder_x = SrcLinTypeData%DerivOrder_x +ENDIF + DstLinTypeData%SizeLin = SrcLinTypeData%SizeLin + DstLinTypeData%LinStartIndx = SrcLinTypeData%LinStartIndx + DstLinTypeData%NumOutputs = SrcLinTypeData%NumOutputs + END SUBROUTINE FAST_CopyLinType - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL InflowWind_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + SUBROUTINE FAST_DestroyLinType( LinTypeData, ErrStat, ErrMsg ) + TYPE(FAST_LinType), INTENT(INOUT) :: LinTypeData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyLinType' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(LinTypeData%Names_u)) THEN + DEALLOCATE(LinTypeData%Names_u) +ENDIF +IF (ALLOCATED(LinTypeData%Names_y)) THEN + DEALLOCATE(LinTypeData%Names_y) +ENDIF +IF (ALLOCATED(LinTypeData%Names_x)) THEN + DEALLOCATE(LinTypeData%Names_x) +ENDIF +IF (ALLOCATED(LinTypeData%Names_xd)) THEN + DEALLOCATE(LinTypeData%Names_xd) +ENDIF +IF (ALLOCATED(LinTypeData%Names_z)) THEN + DEALLOCATE(LinTypeData%Names_z) +ENDIF +IF (ALLOCATED(LinTypeData%op_u)) THEN + DEALLOCATE(LinTypeData%op_u) +ENDIF +IF (ALLOCATED(LinTypeData%op_y)) THEN + DEALLOCATE(LinTypeData%op_y) +ENDIF +IF (ALLOCATED(LinTypeData%op_x)) THEN + DEALLOCATE(LinTypeData%op_x) +ENDIF +IF (ALLOCATED(LinTypeData%op_dx)) THEN + DEALLOCATE(LinTypeData%op_dx) +ENDIF +IF (ALLOCATED(LinTypeData%op_xd)) THEN + DEALLOCATE(LinTypeData%op_xd) +ENDIF +IF (ALLOCATED(LinTypeData%op_z)) THEN + DEALLOCATE(LinTypeData%op_z) +ENDIF +IF (ALLOCATED(LinTypeData%op_x_eig_mag)) THEN + DEALLOCATE(LinTypeData%op_x_eig_mag) +ENDIF +IF (ALLOCATED(LinTypeData%op_x_eig_phase)) THEN + DEALLOCATE(LinTypeData%op_x_eig_phase) +ENDIF +IF (ALLOCATED(LinTypeData%Use_u)) THEN + DEALLOCATE(LinTypeData%Use_u) +ENDIF +IF (ALLOCATED(LinTypeData%Use_y)) THEN + DEALLOCATE(LinTypeData%Use_y) +ENDIF +IF (ALLOCATED(LinTypeData%A)) THEN + DEALLOCATE(LinTypeData%A) +ENDIF +IF (ALLOCATED(LinTypeData%B)) THEN + DEALLOCATE(LinTypeData%B) +ENDIF +IF (ALLOCATED(LinTypeData%C)) THEN + DEALLOCATE(LinTypeData%C) +ENDIF +IF (ALLOCATED(LinTypeData%D)) THEN + DEALLOCATE(LinTypeData%D) +ENDIF +IF (ALLOCATED(LinTypeData%StateRotation)) THEN + DEALLOCATE(LinTypeData%StateRotation) +ENDIF +IF (ALLOCATED(LinTypeData%StateRel_x)) THEN + DEALLOCATE(LinTypeData%StateRel_x) +ENDIF +IF (ALLOCATED(LinTypeData%StateRel_xdot)) THEN + DEALLOCATE(LinTypeData%StateRel_xdot) +ENDIF +IF (ALLOCATED(LinTypeData%IsLoad_u)) THEN + DEALLOCATE(LinTypeData%IsLoad_u) +ENDIF +IF (ALLOCATED(LinTypeData%RotFrame_u)) THEN + DEALLOCATE(LinTypeData%RotFrame_u) +ENDIF +IF (ALLOCATED(LinTypeData%RotFrame_y)) THEN + DEALLOCATE(LinTypeData%RotFrame_y) +ENDIF +IF (ALLOCATED(LinTypeData%RotFrame_x)) THEN + DEALLOCATE(LinTypeData%RotFrame_x) +ENDIF +IF (ALLOCATED(LinTypeData%RotFrame_z)) THEN + DEALLOCATE(LinTypeData%RotFrame_z) +ENDIF +IF (ALLOCATED(LinTypeData%DerivOrder_x)) THEN + DEALLOCATE(LinTypeData%DerivOrder_x) +ENDIF + END SUBROUTINE FAST_DestroyLinType - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL InflowWind_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + SUBROUTINE FAST_PackLinType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(FAST_LinType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackLinType' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - CALL InflowWind_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! Names_u allocated yes/no + IF ( ALLOCATED(InData%Names_u) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Names_u upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%Names_u)*LEN(InData%Names_u) ! Names_u + END IF + Int_BufSz = Int_BufSz + 1 ! Names_y allocated yes/no + IF ( ALLOCATED(InData%Names_y) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Names_y upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%Names_y)*LEN(InData%Names_y) ! Names_y + END IF + Int_BufSz = Int_BufSz + 1 ! Names_x allocated yes/no + IF ( ALLOCATED(InData%Names_x) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Names_x upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%Names_x)*LEN(InData%Names_x) ! Names_x + END IF + Int_BufSz = Int_BufSz + 1 ! Names_xd allocated yes/no + IF ( ALLOCATED(InData%Names_xd) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Names_xd upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%Names_xd)*LEN(InData%Names_xd) ! Names_xd + END IF + Int_BufSz = Int_BufSz + 1 ! Names_z allocated yes/no + IF ( ALLOCATED(InData%Names_z) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Names_z upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%Names_z)*LEN(InData%Names_z) ! Names_z + END IF + Int_BufSz = Int_BufSz + 1 ! op_u allocated yes/no + IF ( ALLOCATED(InData%op_u) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! op_u upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%op_u) ! op_u + END IF + Int_BufSz = Int_BufSz + 1 ! op_y allocated yes/no + IF ( ALLOCATED(InData%op_y) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! op_y upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%op_y) ! op_y + END IF + Int_BufSz = Int_BufSz + 1 ! op_x allocated yes/no + IF ( ALLOCATED(InData%op_x) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! op_x upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%op_x) ! op_x + END IF + Int_BufSz = Int_BufSz + 1 ! op_dx allocated yes/no + IF ( ALLOCATED(InData%op_dx) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! op_dx upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%op_dx) ! op_dx + END IF + Int_BufSz = Int_BufSz + 1 ! op_xd allocated yes/no + IF ( ALLOCATED(InData%op_xd) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! op_xd upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%op_xd) ! op_xd + END IF + Int_BufSz = Int_BufSz + 1 ! op_z allocated yes/no + IF ( ALLOCATED(InData%op_z) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! op_z upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%op_z) ! op_z + END IF + Int_BufSz = Int_BufSz + 1 ! op_x_eig_mag allocated yes/no + IF ( ALLOCATED(InData%op_x_eig_mag) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! op_x_eig_mag upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%op_x_eig_mag) ! op_x_eig_mag + END IF + Int_BufSz = Int_BufSz + 1 ! op_x_eig_phase allocated yes/no + IF ( ALLOCATED(InData%op_x_eig_phase) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! op_x_eig_phase upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%op_x_eig_phase) ! op_x_eig_phase + END IF + Int_BufSz = Int_BufSz + 1 ! Use_u allocated yes/no + IF ( ALLOCATED(InData%Use_u) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Use_u upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%Use_u) ! Use_u + END IF + Int_BufSz = Int_BufSz + 1 ! Use_y allocated yes/no + IF ( ALLOCATED(InData%Use_y) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Use_y upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%Use_y) ! Use_y + END IF + Int_BufSz = Int_BufSz + 1 ! A allocated yes/no + IF ( ALLOCATED(InData%A) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! A upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%A) ! A + END IF + Int_BufSz = Int_BufSz + 1 ! B allocated yes/no + IF ( ALLOCATED(InData%B) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! B upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%B) ! B + END IF + Int_BufSz = Int_BufSz + 1 ! C allocated yes/no + IF ( ALLOCATED(InData%C) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! C upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%C) ! C + END IF + Int_BufSz = Int_BufSz + 1 ! D allocated yes/no + IF ( ALLOCATED(InData%D) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! D upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%D) ! D + END IF + Int_BufSz = Int_BufSz + 1 ! StateRotation allocated yes/no + IF ( ALLOCATED(InData%StateRotation) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! StateRotation upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%StateRotation) ! StateRotation + END IF + Int_BufSz = Int_BufSz + 1 ! StateRel_x allocated yes/no + IF ( ALLOCATED(InData%StateRel_x) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! StateRel_x upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%StateRel_x) ! StateRel_x + END IF + Int_BufSz = Int_BufSz + 1 ! StateRel_xdot allocated yes/no + IF ( ALLOCATED(InData%StateRel_xdot) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! StateRel_xdot upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%StateRel_xdot) ! StateRel_xdot + END IF + Int_BufSz = Int_BufSz + 1 ! IsLoad_u allocated yes/no + IF ( ALLOCATED(InData%IsLoad_u) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! IsLoad_u upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%IsLoad_u) ! IsLoad_u + END IF + Int_BufSz = Int_BufSz + 1 ! RotFrame_u allocated yes/no + IF ( ALLOCATED(InData%RotFrame_u) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! RotFrame_u upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_u) ! RotFrame_u + END IF + Int_BufSz = Int_BufSz + 1 ! RotFrame_y allocated yes/no + IF ( ALLOCATED(InData%RotFrame_y) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! RotFrame_y upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_y) ! RotFrame_y + END IF + Int_BufSz = Int_BufSz + 1 ! RotFrame_x allocated yes/no + IF ( ALLOCATED(InData%RotFrame_x) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! RotFrame_x upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_x) ! RotFrame_x + END IF + Int_BufSz = Int_BufSz + 1 ! RotFrame_z allocated yes/no + IF ( ALLOCATED(InData%RotFrame_z) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! RotFrame_z upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%RotFrame_z) ! RotFrame_z + END IF + Int_BufSz = Int_BufSz + 1 ! DerivOrder_x allocated yes/no + IF ( ALLOCATED(InData%DerivOrder_x) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! DerivOrder_x upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%DerivOrder_x) ! DerivOrder_x + END IF + Int_BufSz = Int_BufSz + SIZE(InData%SizeLin) ! SizeLin + Int_BufSz = Int_BufSz + SIZE(InData%LinStartIndx) ! LinStartIndx + Int_BufSz = Int_BufSz + 1 ! NumOutputs + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + IF ( .NOT. ALLOCATED(InData%Names_u) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Names_u,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Names_u,1) + Int_Xferred = Int_Xferred + 2 - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL InflowWind_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + DO i1 = LBOUND(InData%Names_u,1), UBOUND(InData%Names_u,1) + DO I = 1, LEN(InData%Names_u) + IntKiBuf(Int_Xferred) = ICHAR(InData%Names_u(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Names_y) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Names_y,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Names_y,1) + Int_Xferred = Int_Xferred + 2 - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%Input) ) THEN + DO i1 = LBOUND(InData%Names_y,1), UBOUND(InData%Names_y,1) + DO I = 1, LEN(InData%Names_y) + IntKiBuf(Int_Xferred) = ICHAR(InData%Names_y(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Names_x) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%Names_x,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Names_x,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + DO i1 = LBOUND(InData%Names_x,1), UBOUND(InData%Names_x,1) + DO I = 1, LEN(InData%Names_x) + IntKiBuf(Int_Xferred) = ICHAR(InData%Names_x(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Names_xd) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Names_xd,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Names_xd,1) + Int_Xferred = Int_Xferred + 2 - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO + DO i1 = LBOUND(InData%Names_xd,1), UBOUND(InData%Names_xd,1) + DO I = 1, LEN(InData%Names_xd) + IntKiBuf(Int_Xferred) = ICHAR(InData%Names_xd(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO END IF - IF ( .NOT. ALLOCATED(InData%InputTimes) ) THEN + IF ( .NOT. ALLOCATED(InData%Names_z) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%Names_z,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Names_z,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%InputTimes)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%InputTimes))-1 ) = PACK(InData%InputTimes,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%InputTimes) + DO i1 = LBOUND(InData%Names_z,1), UBOUND(InData%Names_z,1) + DO I = 1, LEN(InData%Names_z) + IntKiBuf(Int_Xferred) = ICHAR(InData%Names_z(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO END IF - END SUBROUTINE FAST_PackInflowWind_Data + IF ( .NOT. ALLOCATED(InData%op_u) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%op_u,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%op_u,1) + Int_Xferred = Int_Xferred + 2 - SUBROUTINE FAST_UnPackInflowWind_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(InflowWind_Data), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackInflowWind_Data' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - i1_l = LBOUND(OutData%x,1) - i1_u = UBOUND(OutData%x,1) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + DO i1 = LBOUND(InData%op_u,1), UBOUND(InData%op_u,1) + ReKiBuf(Re_Xferred) = InData%op_u(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%op_y) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%op_y,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%op_y,1) + Int_Xferred = Int_Xferred + 2 - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - i1_l = LBOUND(OutData%xd,1) - i1_u = UBOUND(OutData%xd,1) - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + DO i1 = LBOUND(InData%op_y,1), UBOUND(InData%op_y,1) + ReKiBuf(Re_Xferred) = InData%op_y(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%op_x) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%op_x,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%op_x,1) + Int_Xferred = Int_Xferred + 2 - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - i1_l = LBOUND(OutData%z,1) - i1_u = UBOUND(OutData%z,1) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - i1_l = LBOUND(OutData%OtherSt,1) - i1_u = UBOUND(OutData%OtherSt,1) - DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + DO i1 = LBOUND(InData%op_x,1), UBOUND(InData%op_x,1) + ReKiBuf(Re_Xferred) = InData%op_x(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%op_dx) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%op_dx,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%op_dx,1) + Int_Xferred = Int_Xferred + 2 - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + DO i1 = LBOUND(InData%op_dx,1), UBOUND(InData%op_dx,1) + ReKiBuf(Re_Xferred) = InData%op_dx(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%op_xd) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%op_xd,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%op_xd,1) + Int_Xferred = Int_Xferred + 2 - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + DO i1 = LBOUND(InData%op_xd,1), UBOUND(InData%op_xd,1) + ReKiBuf(Re_Xferred) = InData%op_xd(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%op_z) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%op_z,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%op_z,1) + Int_Xferred = Int_Xferred + 2 - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + DO i1 = LBOUND(InData%op_z,1), UBOUND(InData%op_z,1) + ReKiBuf(Re_Xferred) = InData%op_z(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%op_x_eig_mag) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%op_x_eig_mag,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%op_x_eig_mag,1) + Int_Xferred = Int_Xferred + 2 - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + DO i1 = LBOUND(InData%op_x_eig_mag,1), UBOUND(InData%op_x_eig_mag,1) + DbKiBuf(Db_Xferred) = InData%op_x_eig_mag(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%op_x_eig_phase) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%op_x_eig_phase,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%op_x_eig_phase,1) + Int_Xferred = Int_Xferred + 2 - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input not allocated + DO i1 = LBOUND(InData%op_x_eig_phase,1), UBOUND(InData%op_x_eig_phase,1) + DbKiBuf(Db_Xferred) = InData%op_x_eig_phase(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Use_u) ) THEN + IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE + IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%Use_u,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Use_u,1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL InflowWind_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO + DO i1 = LBOUND(InData%Use_u,1), UBOUND(InData%Use_u,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%Use_u(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes not allocated + IF ( .NOT. ALLOCATED(InData%Use_y) ) THEN + IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE + IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%Use_y,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Use_y,1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%InputTimes)>0) OutData%InputTimes = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%InputTimes))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%InputTimes) - DEALLOCATE(mask1) + + DO i1 = LBOUND(InData%Use_y,1), UBOUND(InData%Use_y,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%Use_y(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF - END SUBROUTINE FAST_UnPackInflowWind_Data + IF ( .NOT. ALLOCATED(InData%A) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%A,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%A,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%A,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%A,2) + Int_Xferred = Int_Xferred + 2 - SUBROUTINE FAST_CopyOpenFOAM_Data( SrcOpenFOAM_DataData, DstOpenFOAM_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(OpenFOAM_Data), INTENT(INOUT) :: SrcOpenFOAM_DataData - TYPE(OpenFOAM_Data), INTENT(INOUT) :: DstOpenFOAM_DataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyOpenFOAM_Data' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL OpFM_CopyInput( SrcOpenFOAM_DataData%u, DstOpenFOAM_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL OpFM_CopyOutput( SrcOpenFOAM_DataData%y, DstOpenFOAM_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL OpFM_CopyParam( SrcOpenFOAM_DataData%p, DstOpenFOAM_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL OpFM_CopyMisc( SrcOpenFOAM_DataData%m, DstOpenFOAM_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE FAST_CopyOpenFOAM_Data + DO i2 = LBOUND(InData%A,2), UBOUND(InData%A,2) + DO i1 = LBOUND(InData%A,1), UBOUND(InData%A,1) + DbKiBuf(Db_Xferred) = InData%A(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%B) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%B,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%B,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%B,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%B,2) + Int_Xferred = Int_Xferred + 2 - SUBROUTINE FAST_DestroyOpenFOAM_Data( OpenFOAM_DataData, ErrStat, ErrMsg ) - TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpenFOAM_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyOpenFOAM_Data' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" - CALL OpFM_DestroyInput( OpenFOAM_DataData%u, ErrStat, ErrMsg ) - CALL OpFM_DestroyOutput( OpenFOAM_DataData%y, ErrStat, ErrMsg ) - CALL OpFM_DestroyParam( OpenFOAM_DataData%p, ErrStat, ErrMsg ) - CALL OpFM_DestroyMisc( OpenFOAM_DataData%m, ErrStat, ErrMsg ) - END SUBROUTINE FAST_DestroyOpenFOAM_Data + DO i2 = LBOUND(InData%B,2), UBOUND(InData%B,2) + DO i1 = LBOUND(InData%B,1), UBOUND(InData%B,1) + DbKiBuf(Db_Xferred) = InData%B(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%C) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%C,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%C,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C,2) + Int_Xferred = Int_Xferred + 2 - SUBROUTINE FAST_PackOpenFOAM_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(OpenFOAM_Data), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackOpenFOAM_Data' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + DO i2 = LBOUND(InData%C,2), UBOUND(InData%C,2) + DO i1 = LBOUND(InData%C,1), UBOUND(InData%C,1) + DbKiBuf(Db_Xferred) = InData%C(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%D) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%D,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%D,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D,2) + Int_Xferred = Int_Xferred + 2 - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL OpFM_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + DO i2 = LBOUND(InData%D,2), UBOUND(InData%D,2) + DO i1 = LBOUND(InData%D,1), UBOUND(InData%D,1) + DbKiBuf(Db_Xferred) = InData%D(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%StateRotation) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%StateRotation,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StateRotation,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%StateRotation,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StateRotation,2) + Int_Xferred = Int_Xferred + 2 - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL OpFM_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL OpFM_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL OpFM_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF + DO i2 = LBOUND(InData%StateRotation,2), UBOUND(InData%StateRotation,2) + DO i1 = LBOUND(InData%StateRotation,1), UBOUND(InData%StateRotation,1) + DbKiBuf(Db_Xferred) = InData%StateRotation(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF + IF ( .NOT. ALLOCATED(InData%StateRel_x) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%StateRel_x,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StateRel_x,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%StateRel_x,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StateRel_x,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%StateRel_x,2), UBOUND(InData%StateRel_x,2) + DO i1 = LBOUND(InData%StateRel_x,1), UBOUND(InData%StateRel_x,1) + DbKiBuf(Db_Xferred) = InData%StateRel_x(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF + IF ( .NOT. ALLOCATED(InData%StateRel_xdot) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%StateRel_xdot,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StateRel_xdot,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%StateRel_xdot,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StateRel_xdot,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%StateRel_xdot,2), UBOUND(InData%StateRel_xdot,2) + DO i1 = LBOUND(InData%StateRel_xdot,1), UBOUND(InData%StateRel_xdot,1) + DbKiBuf(Db_Xferred) = InData%StateRel_xdot(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + 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 - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 + DO i1 = LBOUND(InData%IsLoad_u,1), UBOUND(InData%IsLoad_u,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%IsLoad_u(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%RotFrame_u) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%RotFrame_u,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_u,1) + Int_Xferred = Int_Xferred + 2 - CALL OpFM_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + DO i1 = LBOUND(InData%RotFrame_u,1), UBOUND(InData%RotFrame_u,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_u(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%RotFrame_y) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%RotFrame_y,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_y,1) + Int_Xferred = Int_Xferred + 2 - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL OpFM_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + DO i1 = LBOUND(InData%RotFrame_y,1), UBOUND(InData%RotFrame_y,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_y(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%RotFrame_x) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%RotFrame_x,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_x,1) + Int_Xferred = Int_Xferred + 2 - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL OpFM_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + DO i1 = LBOUND(InData%RotFrame_x,1), UBOUND(InData%RotFrame_x,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_x(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%RotFrame_z) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%RotFrame_z,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_z,1) + Int_Xferred = Int_Xferred + 2 - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL OpFM_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + DO i1 = LBOUND(InData%RotFrame_z,1), UBOUND(InData%RotFrame_z,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_z(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%DerivOrder_x) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%DerivOrder_x,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%DerivOrder_x,1) + Int_Xferred = Int_Xferred + 2 - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE FAST_PackOpenFOAM_Data + DO i1 = LBOUND(InData%DerivOrder_x,1), UBOUND(InData%DerivOrder_x,1) + IntKiBuf(Int_Xferred) = InData%DerivOrder_x(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + DO i1 = LBOUND(InData%SizeLin,1), UBOUND(InData%SizeLin,1) + IntKiBuf(Int_Xferred) = InData%SizeLin(i1) + Int_Xferred = Int_Xferred + 1 + END DO + DO i1 = LBOUND(InData%LinStartIndx,1), UBOUND(InData%LinStartIndx,1) + IntKiBuf(Int_Xferred) = InData%LinStartIndx(i1) + Int_Xferred = Int_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%NumOutputs + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE FAST_PackLinType - SUBROUTINE FAST_UnPackOpenFOAM_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + SUBROUTINE FAST_UnPackLinType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(OpenFOAM_Data), INTENT(INOUT) :: OutData + TYPE(FAST_LinType), INTENT(INOUT) :: OutData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local variables @@ -14126,15 +13478,11 @@ SUBROUTINE FAST_UnPackOpenFOAM_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackOpenFOAM_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackLinType' ! buffers to store meshes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -14145,230 +13493,644 @@ SUBROUTINE FAST_UnPackOpenFOAM_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL OpFM_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL OpFM_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL OpFM_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL OpFM_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE FAST_UnPackOpenFOAM_Data - - SUBROUTINE FAST_CopySuperController_Data( SrcSuperController_DataData, DstSuperController_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SuperController_Data), INTENT(IN) :: SrcSuperController_DataData - TYPE(SuperController_Data), INTENT(INOUT) :: DstSuperController_DataData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopySuperController_Data' -! - ErrStat = ErrID_None - ErrMsg = "" - CALL SC_CopyInput( SrcSuperController_DataData%u, DstSuperController_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SC_CopyOutput( SrcSuperController_DataData%y, DstSuperController_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SC_CopyParam( SrcSuperController_DataData%p, DstSuperController_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE FAST_CopySuperController_Data - - SUBROUTINE FAST_DestroySuperController_Data( SuperController_DataData, ErrStat, ErrMsg ) - TYPE(SuperController_Data), INTENT(INOUT) :: SuperController_DataData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroySuperController_Data' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" - CALL SC_DestroyInput( SuperController_DataData%u, ErrStat, ErrMsg ) - CALL SC_DestroyOutput( SuperController_DataData%y, ErrStat, ErrMsg ) - CALL SC_DestroyParam( SuperController_DataData%p, ErrStat, ErrMsg ) - END SUBROUTINE FAST_DestroySuperController_Data - - SUBROUTINE FAST_PackSuperController_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SuperController_Data), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackSuperController_Data' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Names_u not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Names_u)) DEALLOCATE(OutData%Names_u) + ALLOCATE(OutData%Names_u(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Names_u.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Names_u,1), UBOUND(OutData%Names_u,1) + DO I = 1, LEN(OutData%Names_u) + OutData%Names_u(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Names_y not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Names_y)) DEALLOCATE(OutData%Names_y) + ALLOCATE(OutData%Names_y(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Names_y.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Names_y,1), UBOUND(OutData%Names_y,1) + DO I = 1, LEN(OutData%Names_y) + OutData%Names_y(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Names_x not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Names_x)) DEALLOCATE(OutData%Names_x) + ALLOCATE(OutData%Names_x(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Names_x.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Names_x,1), UBOUND(OutData%Names_x,1) + DO I = 1, LEN(OutData%Names_x) + OutData%Names_x(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Names_xd not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Names_xd)) DEALLOCATE(OutData%Names_xd) + ALLOCATE(OutData%Names_xd(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Names_xd.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Names_xd,1), UBOUND(OutData%Names_xd,1) + DO I = 1, LEN(OutData%Names_xd) + OutData%Names_xd(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Names_z not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Names_z)) DEALLOCATE(OutData%Names_z) + ALLOCATE(OutData%Names_z(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Names_z.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Names_z,1), UBOUND(OutData%Names_z,1) + DO I = 1, LEN(OutData%Names_z) + OutData%Names_z(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! op_u not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%op_u)) DEALLOCATE(OutData%op_u) + ALLOCATE(OutData%op_u(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_u.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%op_u,1), UBOUND(OutData%op_u,1) + OutData%op_u(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! op_y not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%op_y)) DEALLOCATE(OutData%op_y) + ALLOCATE(OutData%op_y(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_y.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%op_y,1), UBOUND(OutData%op_y,1) + OutData%op_y(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! op_x not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%op_x)) DEALLOCATE(OutData%op_x) + ALLOCATE(OutData%op_x(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_x.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%op_x,1), UBOUND(OutData%op_x,1) + OutData%op_x(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! op_dx not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%op_dx)) DEALLOCATE(OutData%op_dx) + ALLOCATE(OutData%op_dx(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_dx.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%op_dx,1), UBOUND(OutData%op_dx,1) + OutData%op_dx(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! op_xd not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%op_xd)) DEALLOCATE(OutData%op_xd) + ALLOCATE(OutData%op_xd(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_xd.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%op_xd,1), UBOUND(OutData%op_xd,1) + OutData%op_xd(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! op_z not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%op_z)) DEALLOCATE(OutData%op_z) + ALLOCATE(OutData%op_z(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_z.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%op_z,1), UBOUND(OutData%op_z,1) + OutData%op_z(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! op_x_eig_mag not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%op_x_eig_mag)) DEALLOCATE(OutData%op_x_eig_mag) + ALLOCATE(OutData%op_x_eig_mag(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_x_eig_mag.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%op_x_eig_mag,1), UBOUND(OutData%op_x_eig_mag,1) + OutData%op_x_eig_mag(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! op_x_eig_phase not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%op_x_eig_phase)) DEALLOCATE(OutData%op_x_eig_phase) + ALLOCATE(OutData%op_x_eig_phase(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%op_x_eig_phase.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%op_x_eig_phase,1), UBOUND(OutData%op_x_eig_phase,1) + OutData%op_x_eig_phase(i1) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Use_u not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Use_u)) DEALLOCATE(OutData%Use_u) + ALLOCATE(OutData%Use_u(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Use_u.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Use_u,1), UBOUND(OutData%Use_u,1) + OutData%Use_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%Use_u(i1)) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Use_y not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Use_y)) DEALLOCATE(OutData%Use_y) + ALLOCATE(OutData%Use_y(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Use_y.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Use_y,1), UBOUND(OutData%Use_y,1) + OutData%Use_y(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%Use_y(i1)) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! A not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%A)) DEALLOCATE(OutData%A) + ALLOCATE(OutData%A(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%A.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%A,2), UBOUND(OutData%A,2) + DO i1 = LBOUND(OutData%A,1), UBOUND(OutData%A,1) + OutData%A(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! B not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%B)) DEALLOCATE(OutData%B) + ALLOCATE(OutData%B(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%B.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%B,2), UBOUND(OutData%B,2) + DO i1 = LBOUND(OutData%B,1), UBOUND(OutData%B,1) + OutData%B(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%C)) DEALLOCATE(OutData%C) + ALLOCATE(OutData%C(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%C,2), UBOUND(OutData%C,2) + DO i1 = LBOUND(OutData%C,1), UBOUND(OutData%C,1) + OutData%C(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%D)) DEALLOCATE(OutData%D) + ALLOCATE(OutData%D(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%D,2), UBOUND(OutData%D,2) + DO i1 = LBOUND(OutData%D,1), UBOUND(OutData%D,1) + OutData%D(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StateRotation not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%StateRotation)) DEALLOCATE(OutData%StateRotation) + ALLOCATE(OutData%StateRotation(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StateRotation.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%StateRotation,2), UBOUND(OutData%StateRotation,2) + DO i1 = LBOUND(OutData%StateRotation,1), UBOUND(OutData%StateRotation,1) + OutData%StateRotation(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StateRel_x not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%StateRel_x)) DEALLOCATE(OutData%StateRel_x) + ALLOCATE(OutData%StateRel_x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StateRel_x.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%StateRel_x,2), UBOUND(OutData%StateRel_x,2) + DO i1 = LBOUND(OutData%StateRel_x,1), UBOUND(OutData%StateRel_x,1) + OutData%StateRel_x(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StateRel_xdot not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%StateRel_xdot)) DEALLOCATE(OutData%StateRel_xdot) + ALLOCATE(OutData%StateRel_xdot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%StateRel_xdot.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%StateRel_xdot,2), UBOUND(OutData%StateRel_xdot,2) + DO i1 = LBOUND(OutData%StateRel_xdot,1), UBOUND(OutData%StateRel_xdot,1) + OutData%StateRel_xdot(i1,i2) = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IsLoad_u not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%IsLoad_u)) DEALLOCATE(OutData%IsLoad_u) + ALLOCATE(OutData%IsLoad_u(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%IsLoad_u,1), UBOUND(OutData%IsLoad_u,1) + OutData%IsLoad_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsLoad_u(i1)) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_u not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%RotFrame_u)) DEALLOCATE(OutData%RotFrame_u) + ALLOCATE(OutData%RotFrame_u(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%RotFrame_u,1), UBOUND(OutData%RotFrame_u,1) + OutData%RotFrame_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_u(i1)) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_y not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%RotFrame_y)) DEALLOCATE(OutData%RotFrame_y) + ALLOCATE(OutData%RotFrame_y(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%RotFrame_y,1), UBOUND(OutData%RotFrame_y,1) + OutData%RotFrame_y(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_y(i1)) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_x not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%RotFrame_x)) DEALLOCATE(OutData%RotFrame_x) + ALLOCATE(OutData%RotFrame_x(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_x.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%RotFrame_x,1), UBOUND(OutData%RotFrame_x,1) + OutData%RotFrame_x(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_x(i1)) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_z not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%RotFrame_z)) DEALLOCATE(OutData%RotFrame_z) + ALLOCATE(OutData%RotFrame_z(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_z.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%RotFrame_z,1), UBOUND(OutData%RotFrame_z,1) + OutData%RotFrame_z(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_z(i1)) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! DerivOrder_x not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%DerivOrder_x)) DEALLOCATE(OutData%DerivOrder_x) + ALLOCATE(OutData%DerivOrder_x(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%DerivOrder_x.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%DerivOrder_x,1), UBOUND(OutData%DerivOrder_x,1) + OutData%DerivOrder_x(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + i1_l = LBOUND(OutData%SizeLin,1) + i1_u = UBOUND(OutData%SizeLin,1) + DO i1 = LBOUND(OutData%SizeLin,1), UBOUND(OutData%SizeLin,1) + OutData%SizeLin(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + i1_l = LBOUND(OutData%LinStartIndx,1) + i1_u = UBOUND(OutData%LinStartIndx,1) + DO i1 = LBOUND(OutData%LinStartIndx,1), UBOUND(OutData%LinStartIndx,1) + OutData%LinStartIndx(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + OutData%NumOutputs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END SUBROUTINE FAST_UnPackLinType + + SUBROUTINE FAST_CopyModLinType( SrcModLinTypeData, DstModLinTypeData, CtrlCode, ErrStat, ErrMsg ) + TYPE(FAST_ModLinType), INTENT(IN) :: SrcModLinTypeData + TYPE(FAST_ModLinType), INTENT(INOUT) :: DstModLinTypeData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyModLinType' +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(SrcModLinTypeData%Instance)) THEN + i1_l = LBOUND(SrcModLinTypeData%Instance,1) + i1_u = UBOUND(SrcModLinTypeData%Instance,1) + IF (.NOT. ALLOCATED(DstModLinTypeData%Instance)) THEN + ALLOCATE(DstModLinTypeData%Instance(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModLinTypeData%Instance.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcModLinTypeData%Instance,1), UBOUND(SrcModLinTypeData%Instance,1) + CALL FAST_Copylintype( SrcModLinTypeData%Instance(i1), DstModLinTypeData%Instance(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF + END SUBROUTINE FAST_CopyModLinType + + SUBROUTINE FAST_DestroyModLinType( ModLinTypeData, ErrStat, ErrMsg ) + TYPE(FAST_ModLinType), INTENT(INOUT) :: ModLinTypeData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyModLinType' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(ModLinTypeData%Instance)) THEN +DO i1 = LBOUND(ModLinTypeData%Instance,1), UBOUND(ModLinTypeData%Instance,1) + CALL FAST_Destroylintype( ModLinTypeData%Instance(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(ModLinTypeData%Instance) +ENDIF + END SUBROUTINE FAST_DestroyModLinType + + SUBROUTINE FAST_PackModLinType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(FAST_ModLinType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackModLinType' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) OnlySize = .FALSE. @@ -14381,58 +14143,30 @@ SUBROUTINE FAST_PackSuperController_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Er Re_BufSz = 0 Db_BufSz = 0 Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! Instance allocated yes/no + IF ( ALLOCATED(InData%Instance) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Instance upper/lower bounds for each dimension ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL SC_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u + DO i1 = LBOUND(InData%Instance,1), UBOUND(InData%Instance,1) + Int_BufSz = Int_BufSz + 3 ! Instance: size of buffers for each call to pack subtype + CALL FAST_Packlintype( Re_Buf, Db_Buf, Int_Buf, InData%Instance(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Instance CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL SC_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL SC_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p + IF(ALLOCATED(Re_Buf)) THEN ! Instance Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! p + IF(ALLOCATED(Db_Buf)) THEN ! Instance Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! p + IF(ALLOCATED(Int_Buf)) THEN ! Instance Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF + END DO + END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -14460,63 +14194,18 @@ SUBROUTINE FAST_PackSuperController_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Er Db_Xferred = 1 Int_Xferred = 1 - CALL SC_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL SC_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + IF ( .NOT. ALLOCATED(InData%Instance) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Instance,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Instance,1) + Int_Xferred = Int_Xferred + 2 - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL SC_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p + DO i1 = LBOUND(InData%Instance,1), UBOUND(InData%Instance,1) + CALL FAST_Packlintype( Re_Buf, Db_Buf, Int_Buf, InData%Instance(i1), ErrStat2, ErrMsg2, OnlySize ) ! Instance CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -14544,13 +14233,15 @@ SUBROUTINE FAST_PackSuperController_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, Er ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - END SUBROUTINE FAST_PackSuperController_Data + END DO + END IF + END SUBROUTINE FAST_PackModLinType - SUBROUTINE FAST_UnPackSuperController_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + SUBROUTINE FAST_UnPackModLinType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SuperController_Data), INTENT(INOUT) :: OutData + TYPE(FAST_ModLinType), INTENT(INOUT) :: OutData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local variables @@ -14559,15 +14250,10 @@ SUBROUTINE FAST_UnPackSuperController_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackSuperController_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackModLinType' ! buffers to store meshes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -14578,6 +14264,20 @@ SUBROUTINE FAST_UnPackSuperController_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Instance not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Instance)) DEALLOCATE(OutData%Instance) + ALLOCATE(OutData%Instance(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Instance.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Instance,1), UBOUND(OutData%Instance,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -14611,98 +14311,20 @@ SUBROUTINE FAST_UnPackSuperController_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL SC_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SC_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SC_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p + CALL FAST_Unpacklintype( Re_Buf, Db_Buf, Int_Buf, OutData%Instance(i1), ErrStat2, ErrMsg2 ) ! Instance CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE FAST_UnPackSuperController_Data + END DO + END IF + END SUBROUTINE FAST_UnPackModLinType - SUBROUTINE FAST_CopySubDyn_Data( SrcSubDyn_DataData, DstSubDyn_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(SubDyn_Data), INTENT(INOUT) :: SrcSubDyn_DataData - TYPE(SubDyn_Data), INTENT(INOUT) :: DstSubDyn_DataData + SUBROUTINE FAST_CopyLinFileType( SrcLinFileTypeData, DstLinFileTypeData, CtrlCode, ErrStat, ErrMsg ) + TYPE(FAST_LinFileType), INTENT(IN) :: SrcLinFileTypeData + TYPE(FAST_LinFileType), INTENT(INOUT) :: DstLinFileTypeData INTEGER(IntKi), INTENT(IN ) :: CtrlCode INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg @@ -14711,113 +14333,43 @@ SUBROUTINE FAST_CopySubDyn_Data( SrcSubDyn_DataData, DstSubDyn_DataData, CtrlCod INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopySubDyn_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyLinFileType' ! ErrStat = ErrID_None ErrMsg = "" - DO i1 = LBOUND(SrcSubDyn_DataData%x,1), UBOUND(SrcSubDyn_DataData%x,1) - CALL SD_CopyContState( SrcSubDyn_DataData%x(i1), DstSubDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcSubDyn_DataData%xd,1), UBOUND(SrcSubDyn_DataData%xd,1) - CALL SD_CopyDiscState( SrcSubDyn_DataData%xd(i1), DstSubDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcSubDyn_DataData%z,1), UBOUND(SrcSubDyn_DataData%z,1) - CALL SD_CopyConstrState( SrcSubDyn_DataData%z(i1), DstSubDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcSubDyn_DataData%OtherSt,1), UBOUND(SrcSubDyn_DataData%OtherSt,1) - CALL SD_CopyOtherState( SrcSubDyn_DataData%OtherSt(i1), DstSubDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcLinFileTypeData%Modules,1), UBOUND(SrcLinFileTypeData%Modules,1) + CALL FAST_Copymodlintype( SrcLinFileTypeData%Modules(i1), DstLinFileTypeData%Modules(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO - CALL SD_CopyParam( SrcSubDyn_DataData%p, DstSubDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SD_CopyInput( SrcSubDyn_DataData%u, DstSubDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SD_CopyOutput( SrcSubDyn_DataData%y, DstSubDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL SD_CopyMisc( SrcSubDyn_DataData%m, DstSubDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcSubDyn_DataData%Input)) THEN - i1_l = LBOUND(SrcSubDyn_DataData%Input,1) - i1_u = UBOUND(SrcSubDyn_DataData%Input,1) - IF (.NOT. ALLOCATED(DstSubDyn_DataData%Input)) THEN - ALLOCATE(DstSubDyn_DataData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSubDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcSubDyn_DataData%Input,1), UBOUND(SrcSubDyn_DataData%Input,1) - CALL SD_CopyInput( SrcSubDyn_DataData%Input(i1), DstSubDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL FAST_Copylintype( SrcLinFileTypeData%Glue, DstLinFileTypeData%Glue, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcSubDyn_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcSubDyn_DataData%InputTimes,1) - i1_u = UBOUND(SrcSubDyn_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstSubDyn_DataData%InputTimes)) THEN - ALLOCATE(DstSubDyn_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSubDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstSubDyn_DataData%InputTimes = SrcSubDyn_DataData%InputTimes -ENDIF - END SUBROUTINE FAST_CopySubDyn_Data + DstLinFileTypeData%RotSpeed = SrcLinFileTypeData%RotSpeed + DstLinFileTypeData%Azimuth = SrcLinFileTypeData%Azimuth + DstLinFileTypeData%WindSpeed = SrcLinFileTypeData%WindSpeed + END SUBROUTINE FAST_CopyLinFileType - SUBROUTINE FAST_DestroySubDyn_Data( SubDyn_DataData, ErrStat, ErrMsg ) - TYPE(SubDyn_Data), INTENT(INOUT) :: SubDyn_DataData + SUBROUTINE FAST_DestroyLinFileType( LinFileTypeData, ErrStat, ErrMsg ) + TYPE(FAST_LinFileType), INTENT(INOUT) :: LinFileTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroySubDyn_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyLinFileType' INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 ! ErrStat = ErrID_None ErrMsg = "" -DO i1 = LBOUND(SubDyn_DataData%x,1), UBOUND(SubDyn_DataData%x,1) - CALL SD_DestroyContState( SubDyn_DataData%x(i1), ErrStat, ErrMsg ) -ENDDO -DO i1 = LBOUND(SubDyn_DataData%xd,1), UBOUND(SubDyn_DataData%xd,1) - CALL SD_DestroyDiscState( SubDyn_DataData%xd(i1), ErrStat, ErrMsg ) -ENDDO -DO i1 = LBOUND(SubDyn_DataData%z,1), UBOUND(SubDyn_DataData%z,1) - CALL SD_DestroyConstrState( SubDyn_DataData%z(i1), ErrStat, ErrMsg ) -ENDDO -DO i1 = LBOUND(SubDyn_DataData%OtherSt,1), UBOUND(SubDyn_DataData%OtherSt,1) - CALL SD_DestroyOtherState( SubDyn_DataData%OtherSt(i1), ErrStat, ErrMsg ) -ENDDO - CALL SD_DestroyParam( SubDyn_DataData%p, ErrStat, ErrMsg ) - CALL SD_DestroyInput( SubDyn_DataData%u, ErrStat, ErrMsg ) - CALL SD_DestroyOutput( SubDyn_DataData%y, ErrStat, ErrMsg ) - CALL SD_DestroyMisc( SubDyn_DataData%m, ErrStat, ErrMsg ) -IF (ALLOCATED(SubDyn_DataData%Input)) THEN -DO i1 = LBOUND(SubDyn_DataData%Input,1), UBOUND(SubDyn_DataData%Input,1) - CALL SD_DestroyInput( SubDyn_DataData%Input(i1), ErrStat, ErrMsg ) +DO i1 = LBOUND(LinFileTypeData%Modules,1), UBOUND(LinFileTypeData%Modules,1) + CALL FAST_Destroymodlintype( LinFileTypeData%Modules(i1), ErrStat, ErrMsg ) ENDDO - DEALLOCATE(SubDyn_DataData%Input) -ENDIF -IF (ALLOCATED(SubDyn_DataData%InputTimes)) THEN - DEALLOCATE(SubDyn_DataData%InputTimes) -ENDIF - END SUBROUTINE FAST_DestroySubDyn_Data + CALL FAST_Destroylintype( LinFileTypeData%Glue, ErrStat, ErrMsg ) + END SUBROUTINE FAST_DestroyLinFileType - SUBROUTINE FAST_PackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + SUBROUTINE FAST_PackLinFileType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(SubDyn_Data), INTENT(IN) :: InData + TYPE(FAST_LinFileType), INTENT(IN) :: InData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly @@ -14832,7 +14384,7 @@ SUBROUTINE FAST_PackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackSubDyn_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackLinFileType' ! buffers to store subtypes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -14849,178 +14401,45 @@ SUBROUTINE FAST_PackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_BufSz = 0 Int_BufSz = 0 ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL SD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! x - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! x - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! x - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL SD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! xd - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL SD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! z - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! z - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! z - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL SD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt + DO i1 = LBOUND(InData%Modules,1), UBOUND(InData%Modules,1) + Int_BufSz = Int_BufSz + 3 ! Modules: size of buffers for each call to pack subtype + CALL FAST_Packmodlintype( Re_Buf, Db_Buf, Int_Buf, InData%Modules(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Modules CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt + IF(ALLOCATED(Re_Buf)) THEN ! Modules Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt + IF(ALLOCATED(Db_Buf)) THEN ! Modules Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt + IF(ALLOCATED(Int_Buf)) THEN ! Modules Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF END DO - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL SD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL SD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL SD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL SD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL SD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input + Int_BufSz = Int_BufSz + 3 ! Glue: size of buffers for each call to pack subtype + CALL FAST_Packlintype( Re_Buf, Db_Buf, Int_Buf, InData%Glue, ErrStat2, ErrMsg2, .TRUE. ) ! Glue CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! Input + IF(ALLOCATED(Re_Buf)) THEN ! Glue Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input + IF(ALLOCATED(Db_Buf)) THEN ! Glue Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input + IF(ALLOCATED(Int_Buf)) THEN ! Glue Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no - IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes - END IF + Re_BufSz = Re_BufSz + 1 ! RotSpeed + Re_BufSz = Re_BufSz + 1 ! Azimuth + Re_BufSz = Re_BufSz + 1 ! WindSpeed IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -15048,8 +14467,8 @@ SUBROUTINE FAST_PackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = 1 Int_Xferred = 1 - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL SD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x + DO i1 = LBOUND(InData%Modules,1), UBOUND(InData%Modules,1) + CALL FAST_Packmodlintype( Re_Buf, Db_Buf, Int_Buf, InData%Modules(i1), ErrStat2, ErrMsg2, OnlySize ) ! Modules CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -15078,8 +14497,7 @@ SUBROUTINE FAST_PackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL SD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd + CALL FAST_Packlintype( Re_Buf, Db_Buf, Int_Buf, InData%Glue, ErrStat2, ErrMsg2, OnlySize ) ! Glue CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -15107,240 +14525,19 @@ SUBROUTINE FAST_PackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL SD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + ReKiBuf(Re_Xferred) = InData%RotSpeed + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Azimuth + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WindSpeed + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE FAST_PackLinFileType - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL SD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - CALL SD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL SD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL SD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL SD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%Input) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL SD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%InputTimes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%InputTimes)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%InputTimes))-1 ) = PACK(InData%InputTimes,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%InputTimes) - END IF - END SUBROUTINE FAST_PackSubDyn_Data - - SUBROUTINE FAST_UnPackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + SUBROUTINE FAST_UnPackLinFileType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(SubDyn_Data), INTENT(INOUT) :: OutData + TYPE(FAST_LinFileType), INTENT(INOUT) :: OutData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local variables @@ -15349,16 +14546,10 @@ SUBROUTINE FAST_UnPackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackSubDyn_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackLinFileType' ! buffers to store meshes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -15369,53 +14560,9 @@ SUBROUTINE FAST_UnPackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - i1_l = LBOUND(OutData%x,1) - i1_u = UBOUND(OutData%x,1) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - i1_l = LBOUND(OutData%xd,1) - i1_u = UBOUND(OutData%xd,1) - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,1) + i1_l = LBOUND(OutData%Modules,1) + i1_u = UBOUND(OutData%Modules,1) + DO i1 = LBOUND(OutData%Modules,1), UBOUND(OutData%Modules,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -15449,7 +14596,7 @@ SUBROUTINE FAST_UnPackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL SD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd + CALL FAST_Unpackmodlintype( Re_Buf, Db_Buf, Int_Buf, OutData%Modules(i1), ErrStat2, ErrMsg2 ) ! Modules CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -15457,9 +14604,6 @@ SUBROUTINE FAST_UnPackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO - i1_l = LBOUND(OutData%z,1) - i1_u = UBOUND(OutData%z,1) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -15493,417 +14637,635 @@ SUBROUTINE FAST_UnPackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL SD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z + CALL FAST_Unpacklintype( Re_Buf, Db_Buf, Int_Buf, OutData%Glue, ErrStat2, ErrMsg2 ) ! Glue CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - i1_l = LBOUND(OutData%OtherSt,1) - i1_u = UBOUND(OutData%OtherSt,1) - DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + OutData%RotSpeed = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Azimuth = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WindSpeed = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END SUBROUTINE FAST_UnPackLinFileType - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SD_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + SUBROUTINE FAST_CopyMiscLinType( SrcMiscLinTypeData, DstMiscLinTypeData, CtrlCode, ErrStat, ErrMsg ) + TYPE(FAST_MiscLinType), INTENT(IN) :: SrcMiscLinTypeData + TYPE(FAST_MiscLinType), INTENT(INOUT) :: DstMiscLinTypeData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyMiscLinType' +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(SrcMiscLinTypeData%LinTimes)) THEN + i1_l = LBOUND(SrcMiscLinTypeData%LinTimes,1) + i1_u = UBOUND(SrcMiscLinTypeData%LinTimes,1) + IF (.NOT. ALLOCATED(DstMiscLinTypeData%LinTimes)) THEN + ALLOCATE(DstMiscLinTypeData%LinTimes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscLinTypeData%LinTimes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscLinTypeData%LinTimes = SrcMiscLinTypeData%LinTimes +ENDIF + DstMiscLinTypeData%CopyOP_CtrlCode = SrcMiscLinTypeData%CopyOP_CtrlCode +IF (ALLOCATED(SrcMiscLinTypeData%AzimTarget)) THEN + i1_l = LBOUND(SrcMiscLinTypeData%AzimTarget,1) + i1_u = UBOUND(SrcMiscLinTypeData%AzimTarget,1) + IF (.NOT. ALLOCATED(DstMiscLinTypeData%AzimTarget)) THEN + ALLOCATE(DstMiscLinTypeData%AzimTarget(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscLinTypeData%AzimTarget.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscLinTypeData%AzimTarget = SrcMiscLinTypeData%AzimTarget +ENDIF + DstMiscLinTypeData%IsConverged = SrcMiscLinTypeData%IsConverged + DstMiscLinTypeData%FoundSteady = SrcMiscLinTypeData%FoundSteady + DstMiscLinTypeData%n_rot = SrcMiscLinTypeData%n_rot + DstMiscLinTypeData%AzimIndx = SrcMiscLinTypeData%AzimIndx + DstMiscLinTypeData%NextLinTimeIndx = SrcMiscLinTypeData%NextLinTimeIndx +IF (ALLOCATED(SrcMiscLinTypeData%Psi)) THEN + i1_l = LBOUND(SrcMiscLinTypeData%Psi,1) + i1_u = UBOUND(SrcMiscLinTypeData%Psi,1) + IF (.NOT. ALLOCATED(DstMiscLinTypeData%Psi)) THEN + ALLOCATE(DstMiscLinTypeData%Psi(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscLinTypeData%Psi.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscLinTypeData%Psi = SrcMiscLinTypeData%Psi +ENDIF +IF (ALLOCATED(SrcMiscLinTypeData%y_interp)) THEN + i1_l = LBOUND(SrcMiscLinTypeData%y_interp,1) + i1_u = UBOUND(SrcMiscLinTypeData%y_interp,1) + IF (.NOT. ALLOCATED(DstMiscLinTypeData%y_interp)) THEN + ALLOCATE(DstMiscLinTypeData%y_interp(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscLinTypeData%y_interp.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscLinTypeData%y_interp = SrcMiscLinTypeData%y_interp +ENDIF +IF (ALLOCATED(SrcMiscLinTypeData%y_ref)) THEN + i1_l = LBOUND(SrcMiscLinTypeData%y_ref,1) + i1_u = UBOUND(SrcMiscLinTypeData%y_ref,1) + IF (.NOT. ALLOCATED(DstMiscLinTypeData%y_ref)) THEN + ALLOCATE(DstMiscLinTypeData%y_ref(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscLinTypeData%y_ref.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscLinTypeData%y_ref = SrcMiscLinTypeData%y_ref +ENDIF +IF (ALLOCATED(SrcMiscLinTypeData%Y_prevRot)) THEN + i1_l = LBOUND(SrcMiscLinTypeData%Y_prevRot,1) + i1_u = UBOUND(SrcMiscLinTypeData%Y_prevRot,1) + i2_l = LBOUND(SrcMiscLinTypeData%Y_prevRot,2) + i2_u = UBOUND(SrcMiscLinTypeData%Y_prevRot,2) + IF (.NOT. ALLOCATED(DstMiscLinTypeData%Y_prevRot)) THEN + ALLOCATE(DstMiscLinTypeData%Y_prevRot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMiscLinTypeData%Y_prevRot.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMiscLinTypeData%Y_prevRot = SrcMiscLinTypeData%Y_prevRot +ENDIF + END SUBROUTINE FAST_CopyMiscLinType - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + SUBROUTINE FAST_DestroyMiscLinType( MiscLinTypeData, ErrStat, ErrMsg ) + TYPE(FAST_MiscLinType), INTENT(INOUT) :: MiscLinTypeData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyMiscLinType' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(MiscLinTypeData%LinTimes)) THEN + DEALLOCATE(MiscLinTypeData%LinTimes) +ENDIF +IF (ALLOCATED(MiscLinTypeData%AzimTarget)) THEN + DEALLOCATE(MiscLinTypeData%AzimTarget) +ENDIF +IF (ALLOCATED(MiscLinTypeData%Psi)) THEN + DEALLOCATE(MiscLinTypeData%Psi) +ENDIF +IF (ALLOCATED(MiscLinTypeData%y_interp)) THEN + DEALLOCATE(MiscLinTypeData%y_interp) +ENDIF +IF (ALLOCATED(MiscLinTypeData%y_ref)) THEN + DEALLOCATE(MiscLinTypeData%y_ref) +ENDIF +IF (ALLOCATED(MiscLinTypeData%Y_prevRot)) THEN + DEALLOCATE(MiscLinTypeData%Y_prevRot) +ENDIF + END SUBROUTINE FAST_DestroyMiscLinType - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + SUBROUTINE FAST_PackMiscLinType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(FAST_MiscLinType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackMiscLinType' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SD_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! LinTimes allocated yes/no + IF ( ALLOCATED(InData%LinTimes) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! LinTimes upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%LinTimes) ! LinTimes + END IF + Int_BufSz = Int_BufSz + 1 ! CopyOP_CtrlCode + Int_BufSz = Int_BufSz + 1 ! AzimTarget allocated yes/no + IF ( ALLOCATED(InData%AzimTarget) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! AzimTarget upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%AzimTarget) ! AzimTarget + END IF + Int_BufSz = Int_BufSz + 1 ! IsConverged + Int_BufSz = Int_BufSz + 1 ! FoundSteady + Int_BufSz = Int_BufSz + 1 ! n_rot + Int_BufSz = Int_BufSz + 1 ! AzimIndx + Int_BufSz = Int_BufSz + 1 ! NextLinTimeIndx + Int_BufSz = Int_BufSz + 1 ! Psi allocated yes/no + IF ( ALLOCATED(InData%Psi) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Psi upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%Psi) ! Psi + END IF + Int_BufSz = Int_BufSz + 1 ! y_interp allocated yes/no + IF ( ALLOCATED(InData%y_interp) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! y_interp upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%y_interp) ! y_interp + END IF + Int_BufSz = Int_BufSz + 1 ! y_ref allocated yes/no + IF ( ALLOCATED(InData%y_ref) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! y_ref upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%y_ref) ! y_ref + END IF + Int_BufSz = Int_BufSz + 1 ! Y_prevRot allocated yes/no + IF ( ALLOCATED(InData%Y_prevRot) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! Y_prevRot upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Y_prevRot) ! Y_prevRot + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input not allocated + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IF ( .NOT. ALLOCATED(InData%LinTimes) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%LinTimes,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinTimes,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%LinTimes,1), UBOUND(InData%LinTimes,1) + DbKiBuf(Db_Xferred) = InData%LinTimes(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IntKiBuf(Int_Xferred) = InData%CopyOP_CtrlCode + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%AzimTarget) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%AzimTarget,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AzimTarget,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%AzimTarget,1), UBOUND(InData%AzimTarget,1) + DbKiBuf(Db_Xferred) = InData%AzimTarget(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IntKiBuf(Int_Xferred) = TRANSFER(InData%IsConverged, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%FoundSteady, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%n_rot + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%AzimIndx + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NextLinTimeIndx + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%Psi) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Psi,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Psi,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Psi,1), UBOUND(InData%Psi,1) + DbKiBuf(Db_Xferred) = InData%Psi(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%y_interp) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%y_interp,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y_interp,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%y_interp,1), UBOUND(InData%y_interp,1) + ReKiBuf(Re_Xferred) = InData%y_interp(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%y_ref) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%y_ref,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y_ref,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%y_ref,1), UBOUND(InData%y_ref,1) + ReKiBuf(Re_Xferred) = InData%y_ref(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Y_prevRot) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Y_prevRot,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Y_prevRot,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Y_prevRot,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Y_prevRot,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%Y_prevRot,2), UBOUND(InData%Y_prevRot,2) + DO i1 = LBOUND(InData%Y_prevRot,1), UBOUND(InData%Y_prevRot,1) + ReKiBuf(Re_Xferred) = InData%Y_prevRot(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + END SUBROUTINE FAST_PackMiscLinType + + SUBROUTINE FAST_UnPackMiscLinType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(FAST_MiscLinType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackMiscLinType' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinTimes not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%LinTimes)) DEALLOCATE(OutData%LinTimes) + ALLOCATE(OutData%LinTimes(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinTimes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL SD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO + DO i1 = LBOUND(OutData%LinTimes,1), UBOUND(OutData%LinTimes,1) + OutData%LinTimes(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes not allocated + OutData%CopyOP_CtrlCode = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AzimTarget not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%AzimTarget)) DEALLOCATE(OutData%AzimTarget) + ALLOCATE(OutData%AzimTarget(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AzimTarget.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%AzimTarget,1), UBOUND(OutData%AzimTarget,1) + OutData%AzimTarget(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + OutData%IsConverged = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsConverged) + Int_Xferred = Int_Xferred + 1 + OutData%FoundSteady = TRANSFER(IntKiBuf(Int_Xferred), OutData%FoundSteady) + Int_Xferred = Int_Xferred + 1 + OutData%n_rot = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%AzimIndx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NextLinTimeIndx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Psi not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Psi)) DEALLOCATE(OutData%Psi) + ALLOCATE(OutData%Psi(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Psi.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Psi,1), UBOUND(OutData%Psi,1) + OutData%Psi(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! y_interp not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%y_interp)) DEALLOCATE(OutData%y_interp) + ALLOCATE(OutData%y_interp(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_interp.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) + DO i1 = LBOUND(OutData%y_interp,1), UBOUND(OutData%y_interp,1) + OutData%y_interp(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! y_ref not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%y_ref)) DEALLOCATE(OutData%y_ref) + ALLOCATE(OutData%y_ref(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_ref.', ErrStat, ErrMsg,RoutineName) RETURN END IF - mask1 = .TRUE. - IF (SIZE(OutData%InputTimes)>0) OutData%InputTimes = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%InputTimes))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%InputTimes) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%y_ref,1), UBOUND(OutData%y_ref,1) + OutData%y_ref(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - END SUBROUTINE FAST_UnPackSubDyn_Data + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Y_prevRot not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Y_prevRot)) DEALLOCATE(OutData%Y_prevRot) + ALLOCATE(OutData%Y_prevRot(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Y_prevRot.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%Y_prevRot,2), UBOUND(OutData%Y_prevRot,2) + DO i1 = LBOUND(OutData%Y_prevRot,1), UBOUND(OutData%Y_prevRot,1) + OutData%Y_prevRot(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + END SUBROUTINE FAST_UnPackMiscLinType - SUBROUTINE FAST_CopyExtPtfm_Data( SrcExtPtfm_DataData, DstExtPtfm_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(ExtPtfm_Data), INTENT(INOUT) :: SrcExtPtfm_DataData - TYPE(ExtPtfm_Data), INTENT(INOUT) :: DstExtPtfm_DataData + SUBROUTINE FAST_CopyOutputFileType( SrcOutputFileTypeData, DstOutputFileTypeData, CtrlCode, ErrStat, ErrMsg ) + TYPE(FAST_OutputFileType), INTENT(INOUT) :: SrcOutputFileTypeData + TYPE(FAST_OutputFileType), INTENT(INOUT) :: DstOutputFileTypeData INTEGER(IntKi), INTENT(IN ) :: CtrlCode INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local INTEGER(IntKi) :: i,j,k INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyExtPtfm_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyOutputFileType' ! ErrStat = ErrID_None ErrMsg = "" - DO i1 = LBOUND(SrcExtPtfm_DataData%x,1), UBOUND(SrcExtPtfm_DataData%x,1) - CALL ExtPtfm_CopyContState( SrcExtPtfm_DataData%x(i1), DstExtPtfm_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcExtPtfm_DataData%xd,1), UBOUND(SrcExtPtfm_DataData%xd,1) - CALL ExtPtfm_CopyDiscState( SrcExtPtfm_DataData%xd(i1), DstExtPtfm_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcExtPtfm_DataData%z,1), UBOUND(SrcExtPtfm_DataData%z,1) - CALL ExtPtfm_CopyConstrState( SrcExtPtfm_DataData%z(i1), DstExtPtfm_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcExtPtfm_DataData%OtherSt,1), UBOUND(SrcExtPtfm_DataData%OtherSt,1) - CALL ExtPtfm_CopyOtherState( SrcExtPtfm_DataData%OtherSt(i1), DstExtPtfm_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - CALL ExtPtfm_CopyParam( SrcExtPtfm_DataData%p, DstExtPtfm_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL ExtPtfm_CopyInput( SrcExtPtfm_DataData%u, DstExtPtfm_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL ExtPtfm_CopyOutput( SrcExtPtfm_DataData%y, DstExtPtfm_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL ExtPtfm_CopyMisc( SrcExtPtfm_DataData%m, DstExtPtfm_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcExtPtfm_DataData%Input)) THEN - i1_l = LBOUND(SrcExtPtfm_DataData%Input,1) - i1_u = UBOUND(SrcExtPtfm_DataData%Input,1) - IF (.NOT. ALLOCATED(DstExtPtfm_DataData%Input)) THEN - ALLOCATE(DstExtPtfm_DataData%Input(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcOutputFileTypeData%TimeData)) THEN + i1_l = LBOUND(SrcOutputFileTypeData%TimeData,1) + i1_u = UBOUND(SrcOutputFileTypeData%TimeData,1) + IF (.NOT. ALLOCATED(DstOutputFileTypeData%TimeData)) THEN + ALLOCATE(DstOutputFileTypeData%TimeData(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstExtPtfm_DataData%Input.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputFileTypeData%TimeData.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DO i1 = LBOUND(SrcExtPtfm_DataData%Input,1), UBOUND(SrcExtPtfm_DataData%Input,1) - CALL ExtPtfm_CopyInput( SrcExtPtfm_DataData%Input(i1), DstExtPtfm_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO + DstOutputFileTypeData%TimeData = SrcOutputFileTypeData%TimeData ENDIF -IF (ALLOCATED(SrcExtPtfm_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcExtPtfm_DataData%InputTimes,1) - i1_u = UBOUND(SrcExtPtfm_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstExtPtfm_DataData%InputTimes)) THEN - ALLOCATE(DstExtPtfm_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcOutputFileTypeData%AllOutData)) THEN + i1_l = LBOUND(SrcOutputFileTypeData%AllOutData,1) + i1_u = UBOUND(SrcOutputFileTypeData%AllOutData,1) + i2_l = LBOUND(SrcOutputFileTypeData%AllOutData,2) + i2_u = UBOUND(SrcOutputFileTypeData%AllOutData,2) + IF (.NOT. ALLOCATED(DstOutputFileTypeData%AllOutData)) THEN + ALLOCATE(DstOutputFileTypeData%AllOutData(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstExtPtfm_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputFileTypeData%AllOutData.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstExtPtfm_DataData%InputTimes = SrcExtPtfm_DataData%InputTimes + DstOutputFileTypeData%AllOutData = SrcOutputFileTypeData%AllOutData ENDIF - END SUBROUTINE FAST_CopyExtPtfm_Data + DstOutputFileTypeData%n_Out = SrcOutputFileTypeData%n_Out + DstOutputFileTypeData%NOutSteps = SrcOutputFileTypeData%NOutSteps + DstOutputFileTypeData%numOuts = SrcOutputFileTypeData%numOuts + DstOutputFileTypeData%UnOu = SrcOutputFileTypeData%UnOu + DstOutputFileTypeData%UnSum = SrcOutputFileTypeData%UnSum + DstOutputFileTypeData%UnGra = SrcOutputFileTypeData%UnGra + DstOutputFileTypeData%FileDescLines = SrcOutputFileTypeData%FileDescLines +IF (ALLOCATED(SrcOutputFileTypeData%ChannelNames)) THEN + i1_l = LBOUND(SrcOutputFileTypeData%ChannelNames,1) + i1_u = UBOUND(SrcOutputFileTypeData%ChannelNames,1) + IF (.NOT. ALLOCATED(DstOutputFileTypeData%ChannelNames)) THEN + ALLOCATE(DstOutputFileTypeData%ChannelNames(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputFileTypeData%ChannelNames.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstOutputFileTypeData%ChannelNames = SrcOutputFileTypeData%ChannelNames +ENDIF +IF (ALLOCATED(SrcOutputFileTypeData%ChannelUnits)) THEN + i1_l = LBOUND(SrcOutputFileTypeData%ChannelUnits,1) + i1_u = UBOUND(SrcOutputFileTypeData%ChannelUnits,1) + IF (.NOT. ALLOCATED(DstOutputFileTypeData%ChannelUnits)) THEN + ALLOCATE(DstOutputFileTypeData%ChannelUnits(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOutputFileTypeData%ChannelUnits.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstOutputFileTypeData%ChannelUnits = SrcOutputFileTypeData%ChannelUnits +ENDIF + DO i1 = LBOUND(SrcOutputFileTypeData%Module_Ver,1), UBOUND(SrcOutputFileTypeData%Module_Ver,1) + CALL NWTC_Library_Copyprogdesc( SrcOutputFileTypeData%Module_Ver(i1), DstOutputFileTypeData%Module_Ver(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DstOutputFileTypeData%Module_Abrev = SrcOutputFileTypeData%Module_Abrev + DstOutputFileTypeData%WriteThisStep = SrcOutputFileTypeData%WriteThisStep + DstOutputFileTypeData%VTK_count = SrcOutputFileTypeData%VTK_count + DstOutputFileTypeData%VTK_LastWaveIndx = SrcOutputFileTypeData%VTK_LastWaveIndx + CALL FAST_Copylinfiletype( SrcOutputFileTypeData%Lin, DstOutputFileTypeData%Lin, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + DstOutputFileTypeData%ActualChanLen = SrcOutputFileTypeData%ActualChanLen + DstOutputFileTypeData%OutFmt_a = SrcOutputFileTypeData%OutFmt_a + CALL FAST_Copylinstatesave( SrcOutputFileTypeData%op, DstOutputFileTypeData%op, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + END SUBROUTINE FAST_CopyOutputFileType - SUBROUTINE FAST_DestroyExtPtfm_Data( ExtPtfm_DataData, ErrStat, ErrMsg ) - TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm_DataData + SUBROUTINE FAST_DestroyOutputFileType( OutputFileTypeData, ErrStat, ErrMsg ) + TYPE(FAST_OutputFileType), INTENT(INOUT) :: OutputFileTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyExtPtfm_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyOutputFileType' INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 ! ErrStat = ErrID_None ErrMsg = "" -DO i1 = LBOUND(ExtPtfm_DataData%x,1), UBOUND(ExtPtfm_DataData%x,1) - CALL ExtPtfm_DestroyContState( ExtPtfm_DataData%x(i1), ErrStat, ErrMsg ) -ENDDO -DO i1 = LBOUND(ExtPtfm_DataData%xd,1), UBOUND(ExtPtfm_DataData%xd,1) - CALL ExtPtfm_DestroyDiscState( ExtPtfm_DataData%xd(i1), ErrStat, ErrMsg ) -ENDDO -DO i1 = LBOUND(ExtPtfm_DataData%z,1), UBOUND(ExtPtfm_DataData%z,1) - CALL ExtPtfm_DestroyConstrState( ExtPtfm_DataData%z(i1), ErrStat, ErrMsg ) -ENDDO -DO i1 = LBOUND(ExtPtfm_DataData%OtherSt,1), UBOUND(ExtPtfm_DataData%OtherSt,1) - CALL ExtPtfm_DestroyOtherState( ExtPtfm_DataData%OtherSt(i1), ErrStat, ErrMsg ) -ENDDO - CALL ExtPtfm_DestroyParam( ExtPtfm_DataData%p, ErrStat, ErrMsg ) - CALL ExtPtfm_DestroyInput( ExtPtfm_DataData%u, ErrStat, ErrMsg ) - CALL ExtPtfm_DestroyOutput( ExtPtfm_DataData%y, ErrStat, ErrMsg ) - CALL ExtPtfm_DestroyMisc( ExtPtfm_DataData%m, ErrStat, ErrMsg ) -IF (ALLOCATED(ExtPtfm_DataData%Input)) THEN -DO i1 = LBOUND(ExtPtfm_DataData%Input,1), UBOUND(ExtPtfm_DataData%Input,1) - CALL ExtPtfm_DestroyInput( ExtPtfm_DataData%Input(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(ExtPtfm_DataData%Input) +IF (ALLOCATED(OutputFileTypeData%TimeData)) THEN + DEALLOCATE(OutputFileTypeData%TimeData) ENDIF -IF (ALLOCATED(ExtPtfm_DataData%InputTimes)) THEN - DEALLOCATE(ExtPtfm_DataData%InputTimes) +IF (ALLOCATED(OutputFileTypeData%AllOutData)) THEN + DEALLOCATE(OutputFileTypeData%AllOutData) ENDIF - END SUBROUTINE FAST_DestroyExtPtfm_Data +IF (ALLOCATED(OutputFileTypeData%ChannelNames)) THEN + DEALLOCATE(OutputFileTypeData%ChannelNames) +ENDIF +IF (ALLOCATED(OutputFileTypeData%ChannelUnits)) THEN + DEALLOCATE(OutputFileTypeData%ChannelUnits) +ENDIF +DO i1 = LBOUND(OutputFileTypeData%Module_Ver,1), UBOUND(OutputFileTypeData%Module_Ver,1) + CALL NWTC_Library_Destroyprogdesc( OutputFileTypeData%Module_Ver(i1), ErrStat, ErrMsg ) +ENDDO + CALL FAST_Destroylinfiletype( OutputFileTypeData%Lin, ErrStat, ErrMsg ) + CALL FAST_Destroylinstatesave( OutputFileTypeData%op, ErrStat, ErrMsg ) + END SUBROUTINE FAST_DestroyOutputFileType - SUBROUTINE FAST_PackExtPtfm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + SUBROUTINE FAST_PackOutputFileType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(ExtPtfm_Data), INTENT(IN) :: InData + TYPE(FAST_OutputFileType), INTENT(IN) :: InData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly @@ -15918,7 +15280,7 @@ SUBROUTINE FAST_PackExtPtfm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackExtPtfm_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackOutputFileType' ! buffers to store subtypes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -15934,179 +15296,93 @@ SUBROUTINE FAST_PackExtPtfm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Re_BufSz = 0 Db_BufSz = 0 Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! TimeData allocated yes/no + IF ( ALLOCATED(InData%TimeData) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! TimeData upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%TimeData) ! TimeData + END IF + Int_BufSz = Int_BufSz + 1 ! AllOutData allocated yes/no + IF ( ALLOCATED(InData%AllOutData) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! AllOutData upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%AllOutData) ! AllOutData + END IF + Int_BufSz = Int_BufSz + 1 ! n_Out + Int_BufSz = Int_BufSz + 1 ! NOutSteps + Int_BufSz = Int_BufSz + SIZE(InData%numOuts) ! numOuts + Int_BufSz = Int_BufSz + 1 ! UnOu + Int_BufSz = Int_BufSz + 1 ! UnSum + Int_BufSz = Int_BufSz + 1 ! UnGra + Int_BufSz = Int_BufSz + SIZE(InData%FileDescLines)*LEN(InData%FileDescLines) ! FileDescLines + Int_BufSz = Int_BufSz + 1 ! ChannelNames allocated yes/no + IF ( ALLOCATED(InData%ChannelNames) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! ChannelNames upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%ChannelNames)*LEN(InData%ChannelNames) ! ChannelNames + END IF + Int_BufSz = Int_BufSz + 1 ! ChannelUnits allocated yes/no + IF ( ALLOCATED(InData%ChannelUnits) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! ChannelUnits upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%ChannelUnits)*LEN(InData%ChannelUnits) ! ChannelUnits + END IF ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL ExtPtfm_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x + DO i1 = LBOUND(InData%Module_Ver,1), UBOUND(InData%Module_Ver,1) + Int_BufSz = Int_BufSz + 3 ! Module_Ver: size of buffers for each call to pack subtype + CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Module_Ver(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Module_Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! x + IF(ALLOCATED(Re_Buf)) THEN ! Module_Ver Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! x + IF(ALLOCATED(Db_Buf)) THEN ! Module_Ver Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! x + IF(ALLOCATED(Int_Buf)) THEN ! Module_Ver Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL ExtPtfm_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd + Int_BufSz = Int_BufSz + SIZE(InData%Module_Abrev)*LEN(InData%Module_Abrev) ! Module_Abrev + Int_BufSz = Int_BufSz + 1 ! WriteThisStep + Int_BufSz = Int_BufSz + 1 ! VTK_count + Int_BufSz = Int_BufSz + 1 ! VTK_LastWaveIndx + Int_BufSz = Int_BufSz + 3 ! Lin: size of buffers for each call to pack subtype + CALL FAST_Packlinfiletype( Re_Buf, Db_Buf, Int_Buf, InData%Lin, ErrStat2, ErrMsg2, .TRUE. ) ! Lin CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! xd + IF(ALLOCATED(Re_Buf)) THEN ! Lin Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! xd + IF(ALLOCATED(Db_Buf)) THEN ! Lin Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! xd + IF(ALLOCATED(Int_Buf)) THEN ! Lin Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL ExtPtfm_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z + Int_BufSz = Int_BufSz + 1 ! ActualChanLen + Int_BufSz = Int_BufSz + 1*LEN(InData%OutFmt_a) ! OutFmt_a + Int_BufSz = Int_BufSz + 3 ! op: size of buffers for each call to pack subtype + CALL FAST_Packlinstatesave( Re_Buf, Db_Buf, Int_Buf, InData%op, ErrStat2, ErrMsg2, .TRUE. ) ! op CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! z + IF(ALLOCATED(Re_Buf)) THEN ! op Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! z + IF(ALLOCATED(Db_Buf)) THEN ! op Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! z + IF(ALLOCATED(Int_Buf)) THEN ! op Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF - END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL ExtPtfm_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL ExtPtfm_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! p - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! p - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! p - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL ExtPtfm_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! u - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! u - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! u - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL ExtPtfm_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! y - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! y - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! y - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL ExtPtfm_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! m - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! m - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! m - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no - IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL ExtPtfm_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! Input - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! Input - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! Input - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no - IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension - Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes - END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -16134,183 +15410,97 @@ SUBROUTINE FAST_PackExtPtfm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 - DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL ExtPtfm_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL ExtPtfm_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + IF ( .NOT. ALLOCATED(InData%TimeData) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%TimeData,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TimeData,1) + Int_Xferred = Int_Xferred + 2 - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL ExtPtfm_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + DO i1 = LBOUND(InData%TimeData,1), UBOUND(InData%TimeData,1) + DbKiBuf(Db_Xferred) = InData%TimeData(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%AllOutData) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%AllOutData,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AllOutData,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%AllOutData,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AllOutData,2) + Int_Xferred = Int_Xferred + 2 - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF + DO i2 = LBOUND(InData%AllOutData,2), UBOUND(InData%AllOutData,2) + DO i1 = LBOUND(InData%AllOutData,1), UBOUND(InData%AllOutData,1) + ReKiBuf(Re_Xferred) = InData%AllOutData(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IntKiBuf(Int_Xferred) = InData%n_Out + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NOutSteps + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%numOuts,1), UBOUND(InData%numOuts,1) + IntKiBuf(Int_Xferred) = InData%numOuts(i1) + Int_Xferred = Int_Xferred + 1 END DO - DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL ExtPtfm_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF + IntKiBuf(Int_Xferred) = InData%UnOu + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%UnSum + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%UnGra + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%FileDescLines,1), UBOUND(InData%FileDescLines,1) + DO I = 1, LEN(InData%FileDescLines) + IntKiBuf(Int_Xferred) = ICHAR(InData%FileDescLines(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I END DO - CALL ExtPtfm_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + IF ( .NOT. ALLOCATED(InData%ChannelNames) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%ChannelNames,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ChannelNames,1) + Int_Xferred = Int_Xferred + 2 - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL ExtPtfm_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + DO i1 = LBOUND(InData%ChannelNames,1), UBOUND(InData%ChannelNames,1) + DO I = 1, LEN(InData%ChannelNames) + IntKiBuf(Int_Xferred) = ICHAR(InData%ChannelNames(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( .NOT. ALLOCATED(InData%ChannelUnits) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%ChannelUnits,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ChannelUnits,1) + Int_Xferred = Int_Xferred + 2 - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL ExtPtfm_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y + DO i1 = LBOUND(InData%ChannelUnits,1), UBOUND(InData%ChannelUnits,1) + DO I = 1, LEN(InData%ChannelUnits) + IntKiBuf(Int_Xferred) = ICHAR(InData%ChannelUnits(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + DO i1 = LBOUND(InData%Module_Ver,1), UBOUND(InData%Module_Ver,1) + CALL NWTC_Library_Packprogdesc( Re_Buf, Db_Buf, Int_Buf, InData%Module_Ver(i1), ErrStat2, ErrMsg2, OnlySize ) ! Module_Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -16338,7 +15528,20 @@ SUBROUTINE FAST_PackExtPtfm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL ExtPtfm_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m + END DO + DO i1 = LBOUND(InData%Module_Abrev,1), UBOUND(InData%Module_Abrev,1) + DO I = 1, LEN(InData%Module_Abrev) + IntKiBuf(Int_Xferred) = ICHAR(InData%Module_Abrev(i1)(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + IntKiBuf(Int_Xferred) = TRANSFER(InData%WriteThisStep, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%VTK_count + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%VTK_LastWaveIndx + Int_Xferred = Int_Xferred + 1 + CALL FAST_Packlinfiletype( Re_Buf, Db_Buf, Int_Buf, InData%Lin, ErrStat2, ErrMsg2, OnlySize ) ! Lin CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -16366,18 +15569,13 @@ SUBROUTINE FAST_PackExtPtfm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - IF ( .NOT. ALLOCATED(InData%Input) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 + IntKiBuf(Int_Xferred) = InData%ActualChanLen Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL ExtPtfm_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input + DO I = 1, LEN(InData%OutFmt_a) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt_a(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + CALL FAST_Packlinstatesave( Re_Buf, Db_Buf, Int_Buf, InData%op, ErrStat2, ErrMsg2, OnlySize ) ! op CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -16405,28 +15603,13 @@ SUBROUTINE FAST_PackExtPtfm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%InputTimes) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%InputTimes)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%InputTimes))-1 ) = PACK(InData%InputTimes,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%InputTimes) - END IF - END SUBROUTINE FAST_PackExtPtfm_Data + END SUBROUTINE FAST_PackOutputFileType - SUBROUTINE FAST_UnPackExtPtfm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + SUBROUTINE FAST_UnPackOutputFileType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(ExtPtfm_Data), INTENT(INOUT) :: OutData + TYPE(FAST_OutputFileType), INTENT(INOUT) :: OutData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local variables @@ -16435,16 +15618,11 @@ SUBROUTINE FAST_UnPackExtPtfm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackExtPtfm_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackOutputFileType' ! buffers to store meshes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -16455,9 +15633,114 @@ SUBROUTINE FAST_UnPackExtPtfm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - i1_l = LBOUND(OutData%x,1) - i1_u = UBOUND(OutData%x,1) - DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TimeData not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%TimeData)) DEALLOCATE(OutData%TimeData) + ALLOCATE(OutData%TimeData(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TimeData.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%TimeData,1), UBOUND(OutData%TimeData,1) + OutData%TimeData(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AllOutData not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%AllOutData)) DEALLOCATE(OutData%AllOutData) + ALLOCATE(OutData%AllOutData(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOutData.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%AllOutData,2), UBOUND(OutData%AllOutData,2) + DO i1 = LBOUND(OutData%AllOutData,1), UBOUND(OutData%AllOutData,1) + OutData%AllOutData(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + OutData%n_Out = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NOutSteps = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + i1_l = LBOUND(OutData%numOuts,1) + i1_u = UBOUND(OutData%numOuts,1) + DO i1 = LBOUND(OutData%numOuts,1), UBOUND(OutData%numOuts,1) + OutData%numOuts(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + OutData%UnOu = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%UnSum = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%UnGra = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + i1_l = LBOUND(OutData%FileDescLines,1) + i1_u = UBOUND(OutData%FileDescLines,1) + DO i1 = LBOUND(OutData%FileDescLines,1), UBOUND(OutData%FileDescLines,1) + DO I = 1, LEN(OutData%FileDescLines) + OutData%FileDescLines(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ChannelNames not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%ChannelNames)) DEALLOCATE(OutData%ChannelNames) + ALLOCATE(OutData%ChannelNames(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ChannelNames.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%ChannelNames,1), UBOUND(OutData%ChannelNames,1) + DO I = 1, LEN(OutData%ChannelNames) + OutData%ChannelNames(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ChannelUnits not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%ChannelUnits)) DEALLOCATE(OutData%ChannelUnits) + ALLOCATE(OutData%ChannelUnits(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ChannelUnits.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%ChannelUnits,1), UBOUND(OutData%ChannelUnits,1) + DO I = 1, LEN(OutData%ChannelUnits) + OutData%ChannelUnits(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + END IF + i1_l = LBOUND(OutData%Module_Ver,1) + i1_u = UBOUND(OutData%Module_Ver,1) + DO i1 = LBOUND(OutData%Module_Ver,1), UBOUND(OutData%Module_Ver,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -16491,7 +15774,7 @@ SUBROUTINE FAST_UnPackExtPtfm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL ExtPtfm_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x + CALL NWTC_Library_Unpackprogdesc( Re_Buf, Db_Buf, Int_Buf, OutData%Module_Ver(i1), ErrStat2, ErrMsg2 ) ! Module_Ver CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -16499,9 +15782,20 @@ SUBROUTINE FAST_UnPackExtPtfm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO - i1_l = LBOUND(OutData%xd,1) - i1_u = UBOUND(OutData%xd,1) - DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,1) + i1_l = LBOUND(OutData%Module_Abrev,1) + i1_u = UBOUND(OutData%Module_Abrev,1) + DO i1 = LBOUND(OutData%Module_Abrev,1), UBOUND(OutData%Module_Abrev,1) + DO I = 1, LEN(OutData%Module_Abrev) + OutData%Module_Abrev(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + END DO + OutData%WriteThisStep = TRANSFER(IntKiBuf(Int_Xferred), OutData%WriteThisStep) + Int_Xferred = Int_Xferred + 1 + OutData%VTK_count = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%VTK_LastWaveIndx = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -16535,17 +15829,19 @@ SUBROUTINE FAST_UnPackExtPtfm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL ExtPtfm_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd + CALL FAST_Unpacklinfiletype( Re_Buf, Db_Buf, Int_Buf, OutData%Lin, ErrStat2, ErrMsg2 ) ! Lin CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - i1_l = LBOUND(OutData%z,1) - i1_u = UBOUND(OutData%z,1) - DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) + OutData%ActualChanLen = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%OutFmt_a) + OutData%OutFmt_a(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -16579,451 +15875,332 @@ SUBROUTINE FAST_UnPackExtPtfm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL ExtPtfm_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z + CALL FAST_Unpacklinstatesave( Re_Buf, Db_Buf, Int_Buf, OutData%op, ErrStat2, ErrMsg2 ) ! op CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - i1_l = LBOUND(OutData%OtherSt,1) - i1_u = UBOUND(OutData%OtherSt,1) - DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL ExtPtfm_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL ExtPtfm_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL ExtPtfm_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL ExtPtfm_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL ExtPtfm_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL ExtPtfm_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%InputTimes)>0) OutData%InputTimes = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%InputTimes))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%InputTimes) - DEALLOCATE(mask1) - END IF - END SUBROUTINE FAST_UnPackExtPtfm_Data + END SUBROUTINE FAST_UnPackOutputFileType - SUBROUTINE FAST_CopyHydroDyn_Data( SrcHydroDyn_DataData, DstHydroDyn_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(HydroDyn_Data), INTENT(INOUT) :: SrcHydroDyn_DataData - TYPE(HydroDyn_Data), INTENT(INOUT) :: DstHydroDyn_DataData + SUBROUTINE FAST_CopyIceDyn_Data( SrcIceDyn_DataData, DstIceDyn_DataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(IceDyn_Data), INTENT(INOUT) :: SrcIceDyn_DataData + TYPE(IceDyn_Data), INTENT(INOUT) :: DstIceDyn_DataData INTEGER(IntKi), INTENT(IN ) :: CtrlCode INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local INTEGER(IntKi) :: i,j,k INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyHydroDyn_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyIceDyn_Data' ! ErrStat = ErrID_None ErrMsg = "" - DO i1 = LBOUND(SrcHydroDyn_DataData%x,1), UBOUND(SrcHydroDyn_DataData%x,1) - CALL HydroDyn_CopyContState( SrcHydroDyn_DataData%x(i1), DstHydroDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) +IF (ALLOCATED(SrcIceDyn_DataData%x)) THEN + i1_l = LBOUND(SrcIceDyn_DataData%x,1) + i1_u = UBOUND(SrcIceDyn_DataData%x,1) + i2_l = LBOUND(SrcIceDyn_DataData%x,2) + i2_u = UBOUND(SrcIceDyn_DataData%x,2) + IF (.NOT. ALLOCATED(DstIceDyn_DataData%x)) THEN + ALLOCATE(DstIceDyn_DataData%x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%x.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i2 = LBOUND(SrcIceDyn_DataData%x,2), UBOUND(SrcIceDyn_DataData%x,2) + DO i1 = LBOUND(SrcIceDyn_DataData%x,1), UBOUND(SrcIceDyn_DataData%x,1) + CALL IceD_CopyContState( SrcIceDyn_DataData%x(i1,i2), DstIceDyn_DataData%x(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO - DO i1 = LBOUND(SrcHydroDyn_DataData%xd,1), UBOUND(SrcHydroDyn_DataData%xd,1) - CALL HydroDyn_CopyDiscState( SrcHydroDyn_DataData%xd(i1), DstHydroDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) + ENDDO +ENDIF +IF (ALLOCATED(SrcIceDyn_DataData%xd)) THEN + i1_l = LBOUND(SrcIceDyn_DataData%xd,1) + i1_u = UBOUND(SrcIceDyn_DataData%xd,1) + i2_l = LBOUND(SrcIceDyn_DataData%xd,2) + i2_u = UBOUND(SrcIceDyn_DataData%xd,2) + IF (.NOT. ALLOCATED(DstIceDyn_DataData%xd)) THEN + ALLOCATE(DstIceDyn_DataData%xd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%xd.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i2 = LBOUND(SrcIceDyn_DataData%xd,2), UBOUND(SrcIceDyn_DataData%xd,2) + DO i1 = LBOUND(SrcIceDyn_DataData%xd,1), UBOUND(SrcIceDyn_DataData%xd,1) + CALL IceD_CopyDiscState( SrcIceDyn_DataData%xd(i1,i2), DstIceDyn_DataData%xd(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO - DO i1 = LBOUND(SrcHydroDyn_DataData%z,1), UBOUND(SrcHydroDyn_DataData%z,1) - CALL HydroDyn_CopyConstrState( SrcHydroDyn_DataData%z(i1), DstHydroDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) + ENDDO +ENDIF +IF (ALLOCATED(SrcIceDyn_DataData%z)) THEN + i1_l = LBOUND(SrcIceDyn_DataData%z,1) + i1_u = UBOUND(SrcIceDyn_DataData%z,1) + i2_l = LBOUND(SrcIceDyn_DataData%z,2) + i2_u = UBOUND(SrcIceDyn_DataData%z,2) + IF (.NOT. ALLOCATED(DstIceDyn_DataData%z)) THEN + ALLOCATE(DstIceDyn_DataData%z(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%z.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i2 = LBOUND(SrcIceDyn_DataData%z,2), UBOUND(SrcIceDyn_DataData%z,2) + DO i1 = LBOUND(SrcIceDyn_DataData%z,1), UBOUND(SrcIceDyn_DataData%z,1) + CALL IceD_CopyConstrState( SrcIceDyn_DataData%z(i1,i2), DstIceDyn_DataData%z(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO - DO i1 = LBOUND(SrcHydroDyn_DataData%OtherSt,1), UBOUND(SrcHydroDyn_DataData%OtherSt,1) - CALL HydroDyn_CopyOtherState( SrcHydroDyn_DataData%OtherSt(i1), DstHydroDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) + ENDDO +ENDIF +IF (ALLOCATED(SrcIceDyn_DataData%OtherSt)) THEN + i1_l = LBOUND(SrcIceDyn_DataData%OtherSt,1) + i1_u = UBOUND(SrcIceDyn_DataData%OtherSt,1) + i2_l = LBOUND(SrcIceDyn_DataData%OtherSt,2) + i2_u = UBOUND(SrcIceDyn_DataData%OtherSt,2) + IF (.NOT. ALLOCATED(DstIceDyn_DataData%OtherSt)) THEN + ALLOCATE(DstIceDyn_DataData%OtherSt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%OtherSt.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i2 = LBOUND(SrcIceDyn_DataData%OtherSt,2), UBOUND(SrcIceDyn_DataData%OtherSt,2) + DO i1 = LBOUND(SrcIceDyn_DataData%OtherSt,1), UBOUND(SrcIceDyn_DataData%OtherSt,1) + CALL IceD_CopyOtherState( SrcIceDyn_DataData%OtherSt(i1,i2), DstIceDyn_DataData%OtherSt(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO - CALL HydroDyn_CopyParam( SrcHydroDyn_DataData%p, DstHydroDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) + ENDDO +ENDIF +IF (ALLOCATED(SrcIceDyn_DataData%p)) THEN + i1_l = LBOUND(SrcIceDyn_DataData%p,1) + i1_u = UBOUND(SrcIceDyn_DataData%p,1) + IF (.NOT. ALLOCATED(DstIceDyn_DataData%p)) THEN + ALLOCATE(DstIceDyn_DataData%p(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%p.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcIceDyn_DataData%p,1), UBOUND(SrcIceDyn_DataData%p,1) + CALL IceD_CopyParam( SrcIceDyn_DataData%p(i1), DstIceDyn_DataData%p(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - CALL HydroDyn_CopyInput( SrcHydroDyn_DataData%u, DstHydroDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) + ENDDO +ENDIF +IF (ALLOCATED(SrcIceDyn_DataData%u)) THEN + i1_l = LBOUND(SrcIceDyn_DataData%u,1) + i1_u = UBOUND(SrcIceDyn_DataData%u,1) + IF (.NOT. ALLOCATED(DstIceDyn_DataData%u)) THEN + ALLOCATE(DstIceDyn_DataData%u(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%u.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcIceDyn_DataData%u,1), UBOUND(SrcIceDyn_DataData%u,1) + CALL IceD_CopyInput( SrcIceDyn_DataData%u(i1), DstIceDyn_DataData%u(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - CALL HydroDyn_CopyOutput( SrcHydroDyn_DataData%y, DstHydroDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) + ENDDO +ENDIF +IF (ALLOCATED(SrcIceDyn_DataData%y)) THEN + i1_l = LBOUND(SrcIceDyn_DataData%y,1) + i1_u = UBOUND(SrcIceDyn_DataData%y,1) + IF (.NOT. ALLOCATED(DstIceDyn_DataData%y)) THEN + ALLOCATE(DstIceDyn_DataData%y(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%y.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcIceDyn_DataData%y,1), UBOUND(SrcIceDyn_DataData%y,1) + CALL IceD_CopyOutput( SrcIceDyn_DataData%y(i1), DstIceDyn_DataData%y(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - CALL HydroDyn_CopyMisc( SrcHydroDyn_DataData%m, DstHydroDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) + ENDDO +ENDIF +IF (ALLOCATED(SrcIceDyn_DataData%m)) THEN + i1_l = LBOUND(SrcIceDyn_DataData%m,1) + i1_u = UBOUND(SrcIceDyn_DataData%m,1) + IF (.NOT. ALLOCATED(DstIceDyn_DataData%m)) THEN + ALLOCATE(DstIceDyn_DataData%m(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%m.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcIceDyn_DataData%m,1), UBOUND(SrcIceDyn_DataData%m,1) + CALL IceD_CopyMisc( SrcIceDyn_DataData%m(i1), DstIceDyn_DataData%m(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcHydroDyn_DataData%Input)) THEN - i1_l = LBOUND(SrcHydroDyn_DataData%Input,1) - i1_u = UBOUND(SrcHydroDyn_DataData%Input,1) - IF (.NOT. ALLOCATED(DstHydroDyn_DataData%Input)) THEN - ALLOCATE(DstHydroDyn_DataData%Input(i1_l:i1_u),STAT=ErrStat2) + ENDDO +ENDIF +IF (ALLOCATED(SrcIceDyn_DataData%Input)) THEN + i1_l = LBOUND(SrcIceDyn_DataData%Input,1) + i1_u = UBOUND(SrcIceDyn_DataData%Input,1) + i2_l = LBOUND(SrcIceDyn_DataData%Input,2) + i2_u = UBOUND(SrcIceDyn_DataData%Input,2) + IF (.NOT. ALLOCATED(DstIceDyn_DataData%Input)) THEN + ALLOCATE(DstIceDyn_DataData%Input(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstHydroDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DO i1 = LBOUND(SrcHydroDyn_DataData%Input,1), UBOUND(SrcHydroDyn_DataData%Input,1) - CALL HydroDyn_CopyInput( SrcHydroDyn_DataData%Input(i1), DstHydroDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i2 = LBOUND(SrcIceDyn_DataData%Input,2), UBOUND(SrcIceDyn_DataData%Input,2) + DO i1 = LBOUND(SrcIceDyn_DataData%Input,1), UBOUND(SrcIceDyn_DataData%Input,1) + CALL IceD_CopyInput( SrcIceDyn_DataData%Input(i1,i2), DstIceDyn_DataData%Input(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO + ENDDO ENDIF -IF (ALLOCATED(SrcHydroDyn_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcHydroDyn_DataData%InputTimes,1) - i1_u = UBOUND(SrcHydroDyn_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstHydroDyn_DataData%InputTimes)) THEN - ALLOCATE(DstHydroDyn_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcIceDyn_DataData%InputTimes)) THEN + i1_l = LBOUND(SrcIceDyn_DataData%InputTimes,1) + i1_u = UBOUND(SrcIceDyn_DataData%InputTimes,1) + i2_l = LBOUND(SrcIceDyn_DataData%InputTimes,2) + i2_u = UBOUND(SrcIceDyn_DataData%InputTimes,2) + IF (.NOT. ALLOCATED(DstIceDyn_DataData%InputTimes)) THEN + ALLOCATE(DstIceDyn_DataData%InputTimes(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstHydroDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstHydroDyn_DataData%InputTimes = SrcHydroDyn_DataData%InputTimes + DstIceDyn_DataData%InputTimes = SrcIceDyn_DataData%InputTimes ENDIF - END SUBROUTINE FAST_CopyHydroDyn_Data + END SUBROUTINE FAST_CopyIceDyn_Data - SUBROUTINE FAST_DestroyHydroDyn_Data( HydroDyn_DataData, ErrStat, ErrMsg ) - TYPE(HydroDyn_Data), INTENT(INOUT) :: HydroDyn_DataData + SUBROUTINE FAST_DestroyIceDyn_Data( IceDyn_DataData, ErrStat, ErrMsg ) + TYPE(IceDyn_Data), INTENT(INOUT) :: IceDyn_DataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyHydroDyn_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyIceDyn_Data' INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 ! ErrStat = ErrID_None ErrMsg = "" -DO i1 = LBOUND(HydroDyn_DataData%x,1), UBOUND(HydroDyn_DataData%x,1) - CALL HydroDyn_DestroyContState( HydroDyn_DataData%x(i1), ErrStat, ErrMsg ) +IF (ALLOCATED(IceDyn_DataData%x)) THEN +DO i2 = LBOUND(IceDyn_DataData%x,2), UBOUND(IceDyn_DataData%x,2) +DO i1 = LBOUND(IceDyn_DataData%x,1), UBOUND(IceDyn_DataData%x,1) + CALL IceD_DestroyContState( IceDyn_DataData%x(i1,i2), ErrStat, ErrMsg ) ENDDO -DO i1 = LBOUND(HydroDyn_DataData%xd,1), UBOUND(HydroDyn_DataData%xd,1) - CALL HydroDyn_DestroyDiscState( HydroDyn_DataData%xd(i1), ErrStat, ErrMsg ) ENDDO -DO i1 = LBOUND(HydroDyn_DataData%z,1), UBOUND(HydroDyn_DataData%z,1) - CALL HydroDyn_DestroyConstrState( HydroDyn_DataData%z(i1), ErrStat, ErrMsg ) + DEALLOCATE(IceDyn_DataData%x) +ENDIF +IF (ALLOCATED(IceDyn_DataData%xd)) THEN +DO i2 = LBOUND(IceDyn_DataData%xd,2), UBOUND(IceDyn_DataData%xd,2) +DO i1 = LBOUND(IceDyn_DataData%xd,1), UBOUND(IceDyn_DataData%xd,1) + CALL IceD_DestroyDiscState( IceDyn_DataData%xd(i1,i2), ErrStat, ErrMsg ) ENDDO -DO i1 = LBOUND(HydroDyn_DataData%OtherSt,1), UBOUND(HydroDyn_DataData%OtherSt,1) - CALL HydroDyn_DestroyOtherState( HydroDyn_DataData%OtherSt(i1), ErrStat, ErrMsg ) ENDDO - CALL HydroDyn_DestroyParam( HydroDyn_DataData%p, ErrStat, ErrMsg ) - CALL HydroDyn_DestroyInput( HydroDyn_DataData%u, ErrStat, ErrMsg ) - CALL HydroDyn_DestroyOutput( HydroDyn_DataData%y, ErrStat, ErrMsg ) - CALL HydroDyn_DestroyMisc( HydroDyn_DataData%m, ErrStat, ErrMsg ) -IF (ALLOCATED(HydroDyn_DataData%Input)) THEN -DO i1 = LBOUND(HydroDyn_DataData%Input,1), UBOUND(HydroDyn_DataData%Input,1) - CALL HydroDyn_DestroyInput( HydroDyn_DataData%Input(i1), ErrStat, ErrMsg ) + DEALLOCATE(IceDyn_DataData%xd) +ENDIF +IF (ALLOCATED(IceDyn_DataData%z)) THEN +DO i2 = LBOUND(IceDyn_DataData%z,2), UBOUND(IceDyn_DataData%z,2) +DO i1 = LBOUND(IceDyn_DataData%z,1), UBOUND(IceDyn_DataData%z,1) + CALL IceD_DestroyConstrState( IceDyn_DataData%z(i1,i2), ErrStat, ErrMsg ) ENDDO - DEALLOCATE(HydroDyn_DataData%Input) +ENDDO + DEALLOCATE(IceDyn_DataData%z) ENDIF -IF (ALLOCATED(HydroDyn_DataData%InputTimes)) THEN - DEALLOCATE(HydroDyn_DataData%InputTimes) +IF (ALLOCATED(IceDyn_DataData%OtherSt)) THEN +DO i2 = LBOUND(IceDyn_DataData%OtherSt,2), UBOUND(IceDyn_DataData%OtherSt,2) +DO i1 = LBOUND(IceDyn_DataData%OtherSt,1), UBOUND(IceDyn_DataData%OtherSt,1) + CALL IceD_DestroyOtherState( IceDyn_DataData%OtherSt(i1,i2), ErrStat, ErrMsg ) +ENDDO +ENDDO + DEALLOCATE(IceDyn_DataData%OtherSt) ENDIF - END SUBROUTINE FAST_DestroyHydroDyn_Data - - SUBROUTINE FAST_PackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(HydroDyn_Data), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackHydroDyn_Data' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF +IF (ALLOCATED(IceDyn_DataData%p)) THEN +DO i1 = LBOUND(IceDyn_DataData%p,1), UBOUND(IceDyn_DataData%p,1) + CALL IceD_DestroyParam( IceDyn_DataData%p(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(IceDyn_DataData%p) +ENDIF +IF (ALLOCATED(IceDyn_DataData%u)) THEN +DO i1 = LBOUND(IceDyn_DataData%u,1), UBOUND(IceDyn_DataData%u,1) + CALL IceD_DestroyInput( IceDyn_DataData%u(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(IceDyn_DataData%u) +ENDIF +IF (ALLOCATED(IceDyn_DataData%y)) THEN +DO i1 = LBOUND(IceDyn_DataData%y,1), UBOUND(IceDyn_DataData%y,1) + CALL IceD_DestroyOutput( IceDyn_DataData%y(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(IceDyn_DataData%y) +ENDIF +IF (ALLOCATED(IceDyn_DataData%m)) THEN +DO i1 = LBOUND(IceDyn_DataData%m,1), UBOUND(IceDyn_DataData%m,1) + CALL IceD_DestroyMisc( IceDyn_DataData%m(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(IceDyn_DataData%m) +ENDIF +IF (ALLOCATED(IceDyn_DataData%Input)) THEN +DO i2 = LBOUND(IceDyn_DataData%Input,2), UBOUND(IceDyn_DataData%Input,2) +DO i1 = LBOUND(IceDyn_DataData%Input,1), UBOUND(IceDyn_DataData%Input,1) + CALL IceD_DestroyInput( IceDyn_DataData%Input(i1,i2), ErrStat, ErrMsg ) +ENDDO +ENDDO + DEALLOCATE(IceDyn_DataData%Input) +ENDIF +IF (ALLOCATED(IceDyn_DataData%InputTimes)) THEN + DEALLOCATE(IceDyn_DataData%InputTimes) +ENDIF + END SUBROUTINE FAST_DestroyIceDyn_Data + + SUBROUTINE FAST_PackIceDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(IceDyn_Data), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackIceDyn_Data' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF ! ErrStat = ErrID_None ErrMsg = "" Re_BufSz = 0 Db_BufSz = 0 Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! x allocated yes/no + IF ( ALLOCATED(InData%x) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! x upper/lower bounds for each dimension ! Allocate buffers for subtypes, if any (we'll get sizes from these) + DO i2 = LBOUND(InData%x,2), UBOUND(InData%x,2) DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL HydroDyn_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x + CALL IceD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! x CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -17040,9 +16217,15 @@ SUBROUTINE FAST_PackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, DEALLOCATE(Int_Buf) END IF END DO + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! xd allocated yes/no + IF ( ALLOCATED(InData%xd) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! xd upper/lower bounds for each dimension + DO i2 = LBOUND(InData%xd,2), UBOUND(InData%xd,2) DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL HydroDyn_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd + CALL IceD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! xd CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -17059,9 +16242,15 @@ SUBROUTINE FAST_PackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, DEALLOCATE(Int_Buf) END IF END DO + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! z allocated yes/no + IF ( ALLOCATED(InData%z) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! z upper/lower bounds for each dimension + DO i2 = LBOUND(InData%z,2), UBOUND(InData%z,2) DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL HydroDyn_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z + CALL IceD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! z CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -17078,9 +16267,15 @@ SUBROUTINE FAST_PackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, DEALLOCATE(Int_Buf) END IF END DO + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! OtherSt allocated yes/no + IF ( ALLOCATED(InData%OtherSt) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! OtherSt upper/lower bounds for each dimension + DO i2 = LBOUND(InData%OtherSt,2), UBOUND(InData%OtherSt,2) DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL HydroDyn_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt + CALL IceD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -17097,8 +16292,14 @@ SUBROUTINE FAST_PackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, DEALLOCATE(Int_Buf) END IF END DO + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! p allocated yes/no + IF ( ALLOCATED(InData%p) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! p upper/lower bounds for each dimension + DO i1 = LBOUND(InData%p,1), UBOUND(InData%p,1) Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL HydroDyn_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p + CALL IceD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p(i1), ErrStat2, ErrMsg2, .TRUE. ) ! p CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -17114,8 +16315,14 @@ SUBROUTINE FAST_PackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! u allocated yes/no + IF ( ALLOCATED(InData%u) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! u upper/lower bounds for each dimension + DO i1 = LBOUND(InData%u,1), UBOUND(InData%u,1) Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL HydroDyn_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u + CALL IceD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -17131,8 +16338,14 @@ SUBROUTINE FAST_PackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! y allocated yes/no + IF ( ALLOCATED(InData%y) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! y upper/lower bounds for each dimension + DO i1 = LBOUND(InData%y,1), UBOUND(InData%y,1) Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL HydroDyn_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y + CALL IceD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y(i1), ErrStat2, ErrMsg2, .TRUE. ) ! y CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -17148,8 +16361,14 @@ SUBROUTINE FAST_PackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! m allocated yes/no + IF ( ALLOCATED(InData%m) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! m upper/lower bounds for each dimension + DO i1 = LBOUND(InData%m,1), UBOUND(InData%m,1) Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL HydroDyn_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m + CALL IceD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m(i1), ErrStat2, ErrMsg2, .TRUE. ) ! m CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -17165,12 +16384,15 @@ SUBROUTINE FAST_PackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF + END DO + END IF Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + 2*2 ! Input upper/lower bounds for each dimension + DO i2 = LBOUND(InData%Input,2), UBOUND(InData%Input,2) DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL HydroDyn_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input + CALL IceD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! Input CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -17187,10 +16409,11 @@ SUBROUTINE FAST_PackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, DEALLOCATE(Int_Buf) END IF END DO + END DO END IF Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + 2*2 ! InputTimes upper/lower bounds for each dimension Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes END IF IF ( Re_BufSz .GT. 0 ) THEN @@ -17220,8 +16443,22 @@ SUBROUTINE FAST_PackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 + IF ( .NOT. ALLOCATED(InData%x) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%x,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%x,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%x,2), UBOUND(InData%x,2) DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL HydroDyn_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x + CALL IceD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! x CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -17250,8 +16487,24 @@ SUBROUTINE FAST_PackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%xd) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%xd,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%xd,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%xd,2), UBOUND(InData%xd,2) DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL HydroDyn_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd + CALL IceD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! xd CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -17280,8 +16533,24 @@ SUBROUTINE FAST_PackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%z) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%z,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%z,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%z,2), UBOUND(InData%z,2) DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL HydroDyn_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z + CALL IceD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! z CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -17310,8 +16579,24 @@ SUBROUTINE FAST_PackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%OtherSt) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%OtherSt,2), UBOUND(InData%OtherSt,2) DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL HydroDyn_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt + CALL IceD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -17340,7 +16625,20 @@ SUBROUTINE FAST_PackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF END DO - CALL HydroDyn_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p + END DO + END IF + IF ( .NOT. ALLOCATED(InData%p) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%p,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%p,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%p,1), UBOUND(InData%p,1) + CALL IceD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p(i1), ErrStat2, ErrMsg2, OnlySize ) ! p CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -17368,7 +16666,20 @@ SUBROUTINE FAST_PackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL HydroDyn_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u + END DO + END IF + IF ( .NOT. ALLOCATED(InData%u) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%u,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%u,1), UBOUND(InData%u,1) + CALL IceD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u(i1), ErrStat2, ErrMsg2, OnlySize ) ! u CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -17396,7 +16707,20 @@ SUBROUTINE FAST_PackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL HydroDyn_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y + END DO + END IF + IF ( .NOT. ALLOCATED(InData%y) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%y,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%y,1), UBOUND(InData%y,1) + CALL IceD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y(i1), ErrStat2, ErrMsg2, OnlySize ) ! y CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -17424,7 +16748,20 @@ SUBROUTINE FAST_PackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL HydroDyn_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m + END DO + END IF + IF ( .NOT. ALLOCATED(InData%m) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%m,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%m,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%m,1), UBOUND(InData%m,1) + CALL IceD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m(i1), ErrStat2, ErrMsg2, OnlySize ) ! m CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -17452,6 +16789,8 @@ SUBROUTINE FAST_PackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF + END DO + END IF IF ( .NOT. ALLOCATED(InData%Input) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -17461,9 +16800,13 @@ SUBROUTINE FAST_PackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,2) + Int_Xferred = Int_Xferred + 2 + DO i2 = LBOUND(InData%Input,2), UBOUND(InData%Input,2) DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL HydroDyn_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input + CALL IceD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! Input CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -17492,6 +16835,7 @@ SUBROUTINE FAST_PackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%InputTimes) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -17501,18 +16845,25 @@ SUBROUTINE FAST_PackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_Xferred = Int_Xferred + 1 IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%InputTimes)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%InputTimes))-1 ) = PACK(InData%InputTimes,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%InputTimes) + DO i2 = LBOUND(InData%InputTimes,2), UBOUND(InData%InputTimes,2) + DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) + DbKiBuf(Db_Xferred) = InData%InputTimes(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF - END SUBROUTINE FAST_PackHydroDyn_Data + END SUBROUTINE FAST_PackIceDyn_Data - SUBROUTINE FAST_UnPackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + SUBROUTINE FAST_UnPackIceDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(HydroDyn_Data), INTENT(INOUT) :: OutData + TYPE(IceDyn_Data), INTENT(INOUT) :: OutData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local variables @@ -17521,16 +16872,11 @@ SUBROUTINE FAST_UnPackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackHydroDyn_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackIceDyn_Data' ! buffers to store meshes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -17541,8 +16887,23 @@ SUBROUTINE FAST_UnPackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - i1_l = LBOUND(OutData%x,1) - i1_u = UBOUND(OutData%x,1) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%x)) DEALLOCATE(OutData%x) + ALLOCATE(OutData%x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%x,2), UBOUND(OutData%x,2) DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -17577,7 +16938,7 @@ SUBROUTINE FAST_UnPackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL HydroDyn_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x + CALL IceD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1,i2), ErrStat2, ErrMsg2 ) ! x CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -17585,8 +16946,25 @@ SUBROUTINE FAST_UnPackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO - i1_l = LBOUND(OutData%xd,1) - i1_u = UBOUND(OutData%xd,1) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xd not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%xd)) DEALLOCATE(OutData%xd) + ALLOCATE(OutData%xd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%xd,2), UBOUND(OutData%xd,2) DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -17621,7 +16999,7 @@ SUBROUTINE FAST_UnPackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL HydroDyn_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd + CALL IceD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1,i2), ErrStat2, ErrMsg2 ) ! xd CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -17629,8 +17007,25 @@ SUBROUTINE FAST_UnPackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO - i1_l = LBOUND(OutData%z,1) - i1_u = UBOUND(OutData%z,1) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%z)) DEALLOCATE(OutData%z) + ALLOCATE(OutData%z(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%z,2), UBOUND(OutData%z,2) DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -17665,7 +17060,7 @@ SUBROUTINE FAST_UnPackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL HydroDyn_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z + CALL IceD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1,i2), ErrStat2, ErrMsg2 ) ! z CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -17673,8 +17068,25 @@ SUBROUTINE FAST_UnPackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO - i1_l = LBOUND(OutData%OtherSt,1) - i1_u = UBOUND(OutData%OtherSt,1) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OtherSt not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%OtherSt)) DEALLOCATE(OutData%OtherSt) + ALLOCATE(OutData%OtherSt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%OtherSt,2), UBOUND(OutData%OtherSt,2) DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -17709,7 +17121,7 @@ SUBROUTINE FAST_UnPackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL HydroDyn_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt + CALL IceD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1,i2), ErrStat2, ErrMsg2 ) ! OtherSt CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -17717,6 +17129,22 @@ SUBROUTINE FAST_UnPackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! p not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%p)) DEALLOCATE(OutData%p) + ALLOCATE(OutData%p(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%p.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%p,1), UBOUND(OutData%p,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -17750,13 +17178,29 @@ SUBROUTINE FAST_UnPackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL HydroDyn_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p + CALL IceD_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p(i1), ErrStat2, ErrMsg2 ) ! p CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%u)) DEALLOCATE(OutData%u) + ALLOCATE(OutData%u(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%u,1), UBOUND(OutData%u,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -17790,13 +17234,29 @@ SUBROUTINE FAST_UnPackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL HydroDyn_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u + CALL IceD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u(i1), ErrStat2, ErrMsg2 ) ! u CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! y not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%y)) DEALLOCATE(OutData%y) + ALLOCATE(OutData%y(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%y,1), UBOUND(OutData%y,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -17830,13 +17290,29 @@ SUBROUTINE FAST_UnPackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL HydroDyn_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y + CALL IceD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y(i1), ErrStat2, ErrMsg2 ) ! y CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! m not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%m)) DEALLOCATE(OutData%m) + ALLOCATE(OutData%m(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%m.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%m,1), UBOUND(OutData%m,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -17870,13 +17346,15 @@ SUBROUTINE FAST_UnPackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL HydroDyn_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m + CALL IceD_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m(i1), ErrStat2, ErrMsg2 ) ! m CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -17884,12 +17362,16 @@ SUBROUTINE FAST_UnPackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 IF (ALLOCATED(OutData%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) + ALLOCATE(OutData%Input(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) RETURN END IF + DO i2 = LBOUND(OutData%Input,2), UBOUND(OutData%Input,2) DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -17924,7 +17406,7 @@ SUBROUTINE FAST_UnPackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL HydroDyn_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input + CALL IceD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1,i2), ErrStat2, ErrMsg2 ) ! Input CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -17932,6 +17414,7 @@ SUBROUTINE FAST_UnPackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes not allocated Int_Xferred = Int_Xferred + 1 @@ -17940,142 +17423,353 @@ SUBROUTINE FAST_UnPackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 IF (ALLOCATED(OutData%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) + ALLOCATE(OutData%InputTimes(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%InputTimes)>0) OutData%InputTimes = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%InputTimes))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%InputTimes) - DEALLOCATE(mask1) + DO i2 = LBOUND(OutData%InputTimes,2), UBOUND(OutData%InputTimes,2) + DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) + OutData%InputTimes(i1,i2) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF - END SUBROUTINE FAST_UnPackHydroDyn_Data + END SUBROUTINE FAST_UnPackIceDyn_Data - SUBROUTINE FAST_CopyIceFloe_Data( SrcIceFloe_DataData, DstIceFloe_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(IceFloe_Data), INTENT(INOUT) :: SrcIceFloe_DataData - TYPE(IceFloe_Data), INTENT(INOUT) :: DstIceFloe_DataData + SUBROUTINE FAST_CopyBeamDyn_Data( SrcBeamDyn_DataData, DstBeamDyn_DataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(BeamDyn_Data), INTENT(INOUT) :: SrcBeamDyn_DataData + TYPE(BeamDyn_Data), INTENT(INOUT) :: DstBeamDyn_DataData INTEGER(IntKi), INTENT(IN ) :: CtrlCode INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local INTEGER(IntKi) :: i,j,k INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyIceFloe_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyBeamDyn_Data' ! ErrStat = ErrID_None ErrMsg = "" - DO i1 = LBOUND(SrcIceFloe_DataData%x,1), UBOUND(SrcIceFloe_DataData%x,1) - CALL IceFloe_CopyContState( SrcIceFloe_DataData%x(i1), DstIceFloe_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcIceFloe_DataData%xd,1), UBOUND(SrcIceFloe_DataData%xd,1) - CALL IceFloe_CopyDiscState( SrcIceFloe_DataData%xd(i1), DstIceFloe_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO - DO i1 = LBOUND(SrcIceFloe_DataData%z,1), UBOUND(SrcIceFloe_DataData%z,1) - CALL IceFloe_CopyConstrState( SrcIceFloe_DataData%z(i1), DstIceFloe_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) +IF (ALLOCATED(SrcBeamDyn_DataData%x)) THEN + i1_l = LBOUND(SrcBeamDyn_DataData%x,1) + i1_u = UBOUND(SrcBeamDyn_DataData%x,1) + i2_l = LBOUND(SrcBeamDyn_DataData%x,2) + i2_u = UBOUND(SrcBeamDyn_DataData%x,2) + IF (.NOT. ALLOCATED(DstBeamDyn_DataData%x)) THEN + ALLOCATE(DstBeamDyn_DataData%x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%x.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i2 = LBOUND(SrcBeamDyn_DataData%x,2), UBOUND(SrcBeamDyn_DataData%x,2) + DO i1 = LBOUND(SrcBeamDyn_DataData%x,1), UBOUND(SrcBeamDyn_DataData%x,1) + CALL BD_CopyContState( SrcBeamDyn_DataData%x(i1,i2), DstBeamDyn_DataData%x(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO - DO i1 = LBOUND(SrcIceFloe_DataData%OtherSt,1), UBOUND(SrcIceFloe_DataData%OtherSt,1) - CALL IceFloe_CopyOtherState( SrcIceFloe_DataData%OtherSt(i1), DstIceFloe_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN ENDDO - CALL IceFloe_CopyParam( SrcIceFloe_DataData%p, DstIceFloe_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) +ENDIF +IF (ALLOCATED(SrcBeamDyn_DataData%xd)) THEN + i1_l = LBOUND(SrcBeamDyn_DataData%xd,1) + i1_u = UBOUND(SrcBeamDyn_DataData%xd,1) + i2_l = LBOUND(SrcBeamDyn_DataData%xd,2) + i2_u = UBOUND(SrcBeamDyn_DataData%xd,2) + IF (.NOT. ALLOCATED(DstBeamDyn_DataData%xd)) THEN + ALLOCATE(DstBeamDyn_DataData%xd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%xd.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i2 = LBOUND(SrcBeamDyn_DataData%xd,2), UBOUND(SrcBeamDyn_DataData%xd,2) + DO i1 = LBOUND(SrcBeamDyn_DataData%xd,1), UBOUND(SrcBeamDyn_DataData%xd,1) + CALL BD_CopyDiscState( SrcBeamDyn_DataData%xd(i1,i2), DstBeamDyn_DataData%xd(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - CALL IceFloe_CopyInput( SrcIceFloe_DataData%u, DstIceFloe_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) + ENDDO + ENDDO +ENDIF +IF (ALLOCATED(SrcBeamDyn_DataData%z)) THEN + i1_l = LBOUND(SrcBeamDyn_DataData%z,1) + i1_u = UBOUND(SrcBeamDyn_DataData%z,1) + i2_l = LBOUND(SrcBeamDyn_DataData%z,2) + i2_u = UBOUND(SrcBeamDyn_DataData%z,2) + IF (.NOT. ALLOCATED(DstBeamDyn_DataData%z)) THEN + ALLOCATE(DstBeamDyn_DataData%z(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%z.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i2 = LBOUND(SrcBeamDyn_DataData%z,2), UBOUND(SrcBeamDyn_DataData%z,2) + DO i1 = LBOUND(SrcBeamDyn_DataData%z,1), UBOUND(SrcBeamDyn_DataData%z,1) + CALL BD_CopyConstrState( SrcBeamDyn_DataData%z(i1,i2), DstBeamDyn_DataData%z(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - CALL IceFloe_CopyOutput( SrcIceFloe_DataData%y, DstIceFloe_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) + ENDDO + ENDDO +ENDIF +IF (ALLOCATED(SrcBeamDyn_DataData%OtherSt)) THEN + i1_l = LBOUND(SrcBeamDyn_DataData%OtherSt,1) + i1_u = UBOUND(SrcBeamDyn_DataData%OtherSt,1) + i2_l = LBOUND(SrcBeamDyn_DataData%OtherSt,2) + i2_u = UBOUND(SrcBeamDyn_DataData%OtherSt,2) + IF (.NOT. ALLOCATED(DstBeamDyn_DataData%OtherSt)) THEN + ALLOCATE(DstBeamDyn_DataData%OtherSt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%OtherSt.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i2 = LBOUND(SrcBeamDyn_DataData%OtherSt,2), UBOUND(SrcBeamDyn_DataData%OtherSt,2) + DO i1 = LBOUND(SrcBeamDyn_DataData%OtherSt,1), UBOUND(SrcBeamDyn_DataData%OtherSt,1) + CALL BD_CopyOtherState( SrcBeamDyn_DataData%OtherSt(i1,i2), DstBeamDyn_DataData%OtherSt(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - CALL IceFloe_CopyMisc( SrcIceFloe_DataData%m, DstIceFloe_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) + ENDDO + ENDDO +ENDIF +IF (ALLOCATED(SrcBeamDyn_DataData%p)) THEN + i1_l = LBOUND(SrcBeamDyn_DataData%p,1) + i1_u = UBOUND(SrcBeamDyn_DataData%p,1) + IF (.NOT. ALLOCATED(DstBeamDyn_DataData%p)) THEN + ALLOCATE(DstBeamDyn_DataData%p(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%p.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcBeamDyn_DataData%p,1), UBOUND(SrcBeamDyn_DataData%p,1) + CALL BD_CopyParam( SrcBeamDyn_DataData%p(i1), DstBeamDyn_DataData%p(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcIceFloe_DataData%Input)) THEN - i1_l = LBOUND(SrcIceFloe_DataData%Input,1) - i1_u = UBOUND(SrcIceFloe_DataData%Input,1) - IF (.NOT. ALLOCATED(DstIceFloe_DataData%Input)) THEN - ALLOCATE(DstIceFloe_DataData%Input(i1_l:i1_u),STAT=ErrStat2) + ENDDO +ENDIF +IF (ALLOCATED(SrcBeamDyn_DataData%u)) THEN + i1_l = LBOUND(SrcBeamDyn_DataData%u,1) + i1_u = UBOUND(SrcBeamDyn_DataData%u,1) + IF (.NOT. ALLOCATED(DstBeamDyn_DataData%u)) THEN + ALLOCATE(DstBeamDyn_DataData%u(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceFloe_DataData%Input.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%u.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DO i1 = LBOUND(SrcIceFloe_DataData%Input,1), UBOUND(SrcIceFloe_DataData%Input,1) - CALL IceFloe_CopyInput( SrcIceFloe_DataData%Input(i1), DstIceFloe_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcBeamDyn_DataData%u,1), UBOUND(SrcBeamDyn_DataData%u,1) + CALL BD_CopyInput( SrcBeamDyn_DataData%u(i1), DstBeamDyn_DataData%u(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO ENDIF -IF (ALLOCATED(SrcIceFloe_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcIceFloe_DataData%InputTimes,1) - i1_u = UBOUND(SrcIceFloe_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstIceFloe_DataData%InputTimes)) THEN - ALLOCATE(DstIceFloe_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcBeamDyn_DataData%y)) THEN + i1_l = LBOUND(SrcBeamDyn_DataData%y,1) + i1_u = UBOUND(SrcBeamDyn_DataData%y,1) + IF (.NOT. ALLOCATED(DstBeamDyn_DataData%y)) THEN + ALLOCATE(DstBeamDyn_DataData%y(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceFloe_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%y.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstIceFloe_DataData%InputTimes = SrcIceFloe_DataData%InputTimes + DO i1 = LBOUND(SrcBeamDyn_DataData%y,1), UBOUND(SrcBeamDyn_DataData%y,1) + CALL BD_CopyOutput( SrcBeamDyn_DataData%y(i1), DstBeamDyn_DataData%y(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF - END SUBROUTINE FAST_CopyIceFloe_Data +IF (ALLOCATED(SrcBeamDyn_DataData%m)) THEN + i1_l = LBOUND(SrcBeamDyn_DataData%m,1) + i1_u = UBOUND(SrcBeamDyn_DataData%m,1) + IF (.NOT. ALLOCATED(DstBeamDyn_DataData%m)) THEN + ALLOCATE(DstBeamDyn_DataData%m(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%m.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcBeamDyn_DataData%m,1), UBOUND(SrcBeamDyn_DataData%m,1) + CALL BD_CopyMisc( SrcBeamDyn_DataData%m(i1), DstBeamDyn_DataData%m(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcBeamDyn_DataData%Output)) THEN + i1_l = LBOUND(SrcBeamDyn_DataData%Output,1) + i1_u = UBOUND(SrcBeamDyn_DataData%Output,1) + i2_l = LBOUND(SrcBeamDyn_DataData%Output,2) + i2_u = UBOUND(SrcBeamDyn_DataData%Output,2) + IF (.NOT. ALLOCATED(DstBeamDyn_DataData%Output)) THEN + ALLOCATE(DstBeamDyn_DataData%Output(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%Output.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i2 = LBOUND(SrcBeamDyn_DataData%Output,2), UBOUND(SrcBeamDyn_DataData%Output,2) + DO i1 = LBOUND(SrcBeamDyn_DataData%Output,1), UBOUND(SrcBeamDyn_DataData%Output,1) + CALL BD_CopyOutput( SrcBeamDyn_DataData%Output(i1,i2), DstBeamDyn_DataData%Output(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + ENDDO +ENDIF +IF (ALLOCATED(SrcBeamDyn_DataData%y_interp)) THEN + i1_l = LBOUND(SrcBeamDyn_DataData%y_interp,1) + i1_u = UBOUND(SrcBeamDyn_DataData%y_interp,1) + IF (.NOT. ALLOCATED(DstBeamDyn_DataData%y_interp)) THEN + ALLOCATE(DstBeamDyn_DataData%y_interp(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%y_interp.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcBeamDyn_DataData%y_interp,1), UBOUND(SrcBeamDyn_DataData%y_interp,1) + CALL BD_CopyOutput( SrcBeamDyn_DataData%y_interp(i1), DstBeamDyn_DataData%y_interp(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcBeamDyn_DataData%Input)) THEN + i1_l = LBOUND(SrcBeamDyn_DataData%Input,1) + i1_u = UBOUND(SrcBeamDyn_DataData%Input,1) + i2_l = LBOUND(SrcBeamDyn_DataData%Input,2) + i2_u = UBOUND(SrcBeamDyn_DataData%Input,2) + IF (.NOT. ALLOCATED(DstBeamDyn_DataData%Input)) THEN + ALLOCATE(DstBeamDyn_DataData%Input(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i2 = LBOUND(SrcBeamDyn_DataData%Input,2), UBOUND(SrcBeamDyn_DataData%Input,2) + DO i1 = LBOUND(SrcBeamDyn_DataData%Input,1), UBOUND(SrcBeamDyn_DataData%Input,1) + CALL BD_CopyInput( SrcBeamDyn_DataData%Input(i1,i2), DstBeamDyn_DataData%Input(i1,i2), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + ENDDO +ENDIF +IF (ALLOCATED(SrcBeamDyn_DataData%InputTimes)) THEN + i1_l = LBOUND(SrcBeamDyn_DataData%InputTimes,1) + i1_u = UBOUND(SrcBeamDyn_DataData%InputTimes,1) + i2_l = LBOUND(SrcBeamDyn_DataData%InputTimes,2) + i2_u = UBOUND(SrcBeamDyn_DataData%InputTimes,2) + IF (.NOT. ALLOCATED(DstBeamDyn_DataData%InputTimes)) THEN + ALLOCATE(DstBeamDyn_DataData%InputTimes(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBeamDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstBeamDyn_DataData%InputTimes = SrcBeamDyn_DataData%InputTimes +ENDIF + END SUBROUTINE FAST_CopyBeamDyn_Data - SUBROUTINE FAST_DestroyIceFloe_Data( IceFloe_DataData, ErrStat, ErrMsg ) - TYPE(IceFloe_Data), INTENT(INOUT) :: IceFloe_DataData + SUBROUTINE FAST_DestroyBeamDyn_Data( BeamDyn_DataData, ErrStat, ErrMsg ) + TYPE(BeamDyn_Data), INTENT(INOUT) :: BeamDyn_DataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyIceFloe_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyBeamDyn_Data' INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 ! ErrStat = ErrID_None ErrMsg = "" -DO i1 = LBOUND(IceFloe_DataData%x,1), UBOUND(IceFloe_DataData%x,1) - CALL IceFloe_DestroyContState( IceFloe_DataData%x(i1), ErrStat, ErrMsg ) +IF (ALLOCATED(BeamDyn_DataData%x)) THEN +DO i2 = LBOUND(BeamDyn_DataData%x,2), UBOUND(BeamDyn_DataData%x,2) +DO i1 = LBOUND(BeamDyn_DataData%x,1), UBOUND(BeamDyn_DataData%x,1) + CALL BD_DestroyContState( BeamDyn_DataData%x(i1,i2), ErrStat, ErrMsg ) ENDDO -DO i1 = LBOUND(IceFloe_DataData%xd,1), UBOUND(IceFloe_DataData%xd,1) - CALL IceFloe_DestroyDiscState( IceFloe_DataData%xd(i1), ErrStat, ErrMsg ) ENDDO -DO i1 = LBOUND(IceFloe_DataData%z,1), UBOUND(IceFloe_DataData%z,1) - CALL IceFloe_DestroyConstrState( IceFloe_DataData%z(i1), ErrStat, ErrMsg ) + DEALLOCATE(BeamDyn_DataData%x) +ENDIF +IF (ALLOCATED(BeamDyn_DataData%xd)) THEN +DO i2 = LBOUND(BeamDyn_DataData%xd,2), UBOUND(BeamDyn_DataData%xd,2) +DO i1 = LBOUND(BeamDyn_DataData%xd,1), UBOUND(BeamDyn_DataData%xd,1) + CALL BD_DestroyDiscState( BeamDyn_DataData%xd(i1,i2), ErrStat, ErrMsg ) ENDDO -DO i1 = LBOUND(IceFloe_DataData%OtherSt,1), UBOUND(IceFloe_DataData%OtherSt,1) - CALL IceFloe_DestroyOtherState( IceFloe_DataData%OtherSt(i1), ErrStat, ErrMsg ) ENDDO - CALL IceFloe_DestroyParam( IceFloe_DataData%p, ErrStat, ErrMsg ) - CALL IceFloe_DestroyInput( IceFloe_DataData%u, ErrStat, ErrMsg ) - CALL IceFloe_DestroyOutput( IceFloe_DataData%y, ErrStat, ErrMsg ) - CALL IceFloe_DestroyMisc( IceFloe_DataData%m, ErrStat, ErrMsg ) -IF (ALLOCATED(IceFloe_DataData%Input)) THEN -DO i1 = LBOUND(IceFloe_DataData%Input,1), UBOUND(IceFloe_DataData%Input,1) - CALL IceFloe_DestroyInput( IceFloe_DataData%Input(i1), ErrStat, ErrMsg ) + DEALLOCATE(BeamDyn_DataData%xd) +ENDIF +IF (ALLOCATED(BeamDyn_DataData%z)) THEN +DO i2 = LBOUND(BeamDyn_DataData%z,2), UBOUND(BeamDyn_DataData%z,2) +DO i1 = LBOUND(BeamDyn_DataData%z,1), UBOUND(BeamDyn_DataData%z,1) + CALL BD_DestroyConstrState( BeamDyn_DataData%z(i1,i2), ErrStat, ErrMsg ) ENDDO - DEALLOCATE(IceFloe_DataData%Input) +ENDDO + DEALLOCATE(BeamDyn_DataData%z) ENDIF -IF (ALLOCATED(IceFloe_DataData%InputTimes)) THEN - DEALLOCATE(IceFloe_DataData%InputTimes) +IF (ALLOCATED(BeamDyn_DataData%OtherSt)) THEN +DO i2 = LBOUND(BeamDyn_DataData%OtherSt,2), UBOUND(BeamDyn_DataData%OtherSt,2) +DO i1 = LBOUND(BeamDyn_DataData%OtherSt,1), UBOUND(BeamDyn_DataData%OtherSt,1) + CALL BD_DestroyOtherState( BeamDyn_DataData%OtherSt(i1,i2), ErrStat, ErrMsg ) +ENDDO +ENDDO + DEALLOCATE(BeamDyn_DataData%OtherSt) ENDIF - END SUBROUTINE FAST_DestroyIceFloe_Data +IF (ALLOCATED(BeamDyn_DataData%p)) THEN +DO i1 = LBOUND(BeamDyn_DataData%p,1), UBOUND(BeamDyn_DataData%p,1) + CALL BD_DestroyParam( BeamDyn_DataData%p(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(BeamDyn_DataData%p) +ENDIF +IF (ALLOCATED(BeamDyn_DataData%u)) THEN +DO i1 = LBOUND(BeamDyn_DataData%u,1), UBOUND(BeamDyn_DataData%u,1) + CALL BD_DestroyInput( BeamDyn_DataData%u(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(BeamDyn_DataData%u) +ENDIF +IF (ALLOCATED(BeamDyn_DataData%y)) THEN +DO i1 = LBOUND(BeamDyn_DataData%y,1), UBOUND(BeamDyn_DataData%y,1) + CALL BD_DestroyOutput( BeamDyn_DataData%y(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(BeamDyn_DataData%y) +ENDIF +IF (ALLOCATED(BeamDyn_DataData%m)) THEN +DO i1 = LBOUND(BeamDyn_DataData%m,1), UBOUND(BeamDyn_DataData%m,1) + CALL BD_DestroyMisc( BeamDyn_DataData%m(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(BeamDyn_DataData%m) +ENDIF +IF (ALLOCATED(BeamDyn_DataData%Output)) THEN +DO i2 = LBOUND(BeamDyn_DataData%Output,2), UBOUND(BeamDyn_DataData%Output,2) +DO i1 = LBOUND(BeamDyn_DataData%Output,1), UBOUND(BeamDyn_DataData%Output,1) + CALL BD_DestroyOutput( BeamDyn_DataData%Output(i1,i2), ErrStat, ErrMsg ) +ENDDO +ENDDO + DEALLOCATE(BeamDyn_DataData%Output) +ENDIF +IF (ALLOCATED(BeamDyn_DataData%y_interp)) THEN +DO i1 = LBOUND(BeamDyn_DataData%y_interp,1), UBOUND(BeamDyn_DataData%y_interp,1) + CALL BD_DestroyOutput( BeamDyn_DataData%y_interp(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(BeamDyn_DataData%y_interp) +ENDIF +IF (ALLOCATED(BeamDyn_DataData%Input)) THEN +DO i2 = LBOUND(BeamDyn_DataData%Input,2), UBOUND(BeamDyn_DataData%Input,2) +DO i1 = LBOUND(BeamDyn_DataData%Input,1), UBOUND(BeamDyn_DataData%Input,1) + CALL BD_DestroyInput( BeamDyn_DataData%Input(i1,i2), ErrStat, ErrMsg ) +ENDDO +ENDDO + DEALLOCATE(BeamDyn_DataData%Input) +ENDIF +IF (ALLOCATED(BeamDyn_DataData%InputTimes)) THEN + DEALLOCATE(BeamDyn_DataData%InputTimes) +ENDIF + END SUBROUTINE FAST_DestroyBeamDyn_Data - SUBROUTINE FAST_PackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + SUBROUTINE FAST_PackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(IceFloe_Data), INTENT(IN) :: InData + TYPE(BeamDyn_Data), INTENT(IN) :: InData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly @@ -18090,7 +17784,7 @@ SUBROUTINE FAST_PackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackIceFloe_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackBeamDyn_Data' ! buffers to store subtypes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -18106,10 +17800,14 @@ SUBROUTINE FAST_PackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Re_BufSz = 0 Db_BufSz = 0 Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! x allocated yes/no + IF ( ALLOCATED(InData%x) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! x upper/lower bounds for each dimension ! Allocate buffers for subtypes, if any (we'll get sizes from these) + DO i2 = LBOUND(InData%x,2), UBOUND(InData%x,2) DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL IceFloe_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x + CALL BD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! x CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -18126,9 +17824,15 @@ SUBROUTINE FAST_PackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E DEALLOCATE(Int_Buf) END IF END DO + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! xd allocated yes/no + IF ( ALLOCATED(InData%xd) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! xd upper/lower bounds for each dimension + DO i2 = LBOUND(InData%xd,2), UBOUND(InData%xd,2) DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL IceFloe_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd + CALL BD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! xd CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -18145,9 +17849,15 @@ SUBROUTINE FAST_PackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E DEALLOCATE(Int_Buf) END IF END DO + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! z allocated yes/no + IF ( ALLOCATED(InData%z) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! z upper/lower bounds for each dimension + DO i2 = LBOUND(InData%z,2), UBOUND(InData%z,2) DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL IceFloe_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z + CALL BD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! z CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -18164,9 +17874,15 @@ SUBROUTINE FAST_PackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E DEALLOCATE(Int_Buf) END IF END DO + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! OtherSt allocated yes/no + IF ( ALLOCATED(InData%OtherSt) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! OtherSt upper/lower bounds for each dimension + DO i2 = LBOUND(InData%OtherSt,2), UBOUND(InData%OtherSt,2) DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL IceFloe_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt + CALL BD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -18183,8 +17899,14 @@ SUBROUTINE FAST_PackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E DEALLOCATE(Int_Buf) END IF END DO + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! p allocated yes/no + IF ( ALLOCATED(InData%p) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! p upper/lower bounds for each dimension + DO i1 = LBOUND(InData%p,1), UBOUND(InData%p,1) Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL IceFloe_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p + CALL BD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p(i1), ErrStat2, ErrMsg2, .TRUE. ) ! p CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -18200,8 +17922,14 @@ SUBROUTINE FAST_PackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! u allocated yes/no + IF ( ALLOCATED(InData%u) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! u upper/lower bounds for each dimension + DO i1 = LBOUND(InData%u,1), UBOUND(InData%u,1) Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL IceFloe_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u + CALL BD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u(i1), ErrStat2, ErrMsg2, .TRUE. ) ! u CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -18217,8 +17945,14 @@ SUBROUTINE FAST_PackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! y allocated yes/no + IF ( ALLOCATED(InData%y) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! y upper/lower bounds for each dimension + DO i1 = LBOUND(InData%y,1), UBOUND(InData%y,1) Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL IceFloe_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y + CALL BD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y(i1), ErrStat2, ErrMsg2, .TRUE. ) ! y CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -18234,8 +17968,14 @@ SUBROUTINE FAST_PackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! m allocated yes/no + IF ( ALLOCATED(InData%m) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! m upper/lower bounds for each dimension + DO i1 = LBOUND(InData%m,1), UBOUND(InData%m,1) Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL IceFloe_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m + CALL BD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m(i1), ErrStat2, ErrMsg2, .TRUE. ) ! m CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -18251,12 +17991,63 @@ SUBROUTINE FAST_PackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! Output allocated yes/no + IF ( ALLOCATED(InData%Output) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! Output upper/lower bounds for each dimension + DO i2 = LBOUND(InData%Output,2), UBOUND(InData%Output,2) + DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) + Int_BufSz = Int_BufSz + 3 ! Output: size of buffers for each call to pack subtype + CALL BD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! Output + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Output + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Output + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Output + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! y_interp allocated yes/no + IF ( ALLOCATED(InData%y_interp) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! y_interp upper/lower bounds for each dimension + DO i1 = LBOUND(InData%y_interp,1), UBOUND(InData%y_interp,1) + Int_BufSz = Int_BufSz + 3 ! y_interp: size of buffers for each call to pack subtype + CALL BD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp(i1), ErrStat2, ErrMsg2, .TRUE. ) ! y_interp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! y_interp + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! y_interp + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! y_interp + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no IF ( ALLOCATED(InData%Input) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + 2*2 ! Input upper/lower bounds for each dimension + DO i2 = LBOUND(InData%Input,2), UBOUND(InData%Input,2) DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL IceFloe_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input + CALL BD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1,i2), ErrStat2, ErrMsg2, .TRUE. ) ! Input CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -18273,10 +18064,11 @@ SUBROUTINE FAST_PackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E DEALLOCATE(Int_Buf) END IF END DO + END DO END IF Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no IF ( ALLOCATED(InData%InputTimes) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + 2*2 ! InputTimes upper/lower bounds for each dimension Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes END IF IF ( Re_BufSz .GT. 0 ) THEN @@ -18306,8 +18098,22 @@ SUBROUTINE FAST_PackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Db_Xferred = 1 Int_Xferred = 1 + IF ( .NOT. ALLOCATED(InData%x) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%x,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%x,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%x,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%x,2), UBOUND(InData%x,2) DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL IceFloe_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x + CALL BD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! x CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -18336,8 +18142,24 @@ SUBROUTINE FAST_PackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%xd) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%xd,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%xd,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%xd,2), UBOUND(InData%xd,2) DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL IceFloe_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd + CALL BD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! xd CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -18366,8 +18188,24 @@ SUBROUTINE FAST_PackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%z) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%z,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%z,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%z,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%z,2), UBOUND(InData%z,2) DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL IceFloe_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z + CALL BD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! z CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -18396,8 +18234,24 @@ SUBROUTINE FAST_PackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%OtherSt) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%OtherSt,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OtherSt,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%OtherSt,2), UBOUND(InData%OtherSt,2) DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL IceFloe_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt + CALL BD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -18426,7 +18280,20 @@ SUBROUTINE FAST_PackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF END DO - CALL IceFloe_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p + END DO + END IF + IF ( .NOT. ALLOCATED(InData%p) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%p,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%p,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%p,1), UBOUND(InData%p,1) + CALL BD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p(i1), ErrStat2, ErrMsg2, OnlySize ) ! p CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -18454,7 +18321,20 @@ SUBROUTINE FAST_PackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL IceFloe_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u + END DO + END IF + IF ( .NOT. ALLOCATED(InData%u) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%u,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%u,1), UBOUND(InData%u,1) + CALL BD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u(i1), ErrStat2, ErrMsg2, OnlySize ) ! u CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -18482,7 +18362,20 @@ SUBROUTINE FAST_PackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL IceFloe_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y + END DO + END IF + IF ( .NOT. ALLOCATED(InData%y) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%y,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%y,1), UBOUND(InData%y,1) + CALL BD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y(i1), ErrStat2, ErrMsg2, OnlySize ) ! y CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -18510,7 +18403,20 @@ SUBROUTINE FAST_PackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL IceFloe_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m + END DO + END IF + IF ( .NOT. ALLOCATED(InData%m) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%m,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%m,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%m,1), UBOUND(InData%m,1) + CALL BD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m(i1), ErrStat2, ErrMsg2, OnlySize ) ! m CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -18538,8 +18444,97 @@ SUBROUTINE FAST_PackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - IF ( .NOT. ALLOCATED(InData%Input) ) THEN - IntKiBuf( Int_Xferred ) = 0 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Output) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Output,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Output,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Output,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Output,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%Output,2), UBOUND(InData%Output,2) + DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) + CALL BD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! Output + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%y_interp) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%y_interp,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y_interp,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%y_interp,1), UBOUND(InData%y_interp,1) + CALL BD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp(i1), ErrStat2, ErrMsg2, OnlySize ) ! y_interp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Input) ) THEN + IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 @@ -18547,9 +18542,13 @@ SUBROUTINE FAST_PackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,2) + Int_Xferred = Int_Xferred + 2 + DO i2 = LBOUND(InData%Input,2), UBOUND(InData%Input,2) DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL IceFloe_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input + CALL BD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1,i2), ErrStat2, ErrMsg2, OnlySize ) ! Input CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -18578,6 +18577,7 @@ SUBROUTINE FAST_PackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%InputTimes) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -18587,18 +18587,25 @@ SUBROUTINE FAST_PackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_Xferred = Int_Xferred + 1 IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%InputTimes)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%InputTimes))-1 ) = PACK(InData%InputTimes,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%InputTimes) + DO i2 = LBOUND(InData%InputTimes,2), UBOUND(InData%InputTimes,2) + DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) + DbKiBuf(Db_Xferred) = InData%InputTimes(i1,i2) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF - END SUBROUTINE FAST_PackIceFloe_Data + END SUBROUTINE FAST_PackBeamDyn_Data - SUBROUTINE FAST_UnPackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + SUBROUTINE FAST_UnPackBeamDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(IceFloe_Data), INTENT(INOUT) :: OutData + TYPE(BeamDyn_Data), INTENT(INOUT) :: OutData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local variables @@ -18607,16 +18614,11 @@ SUBROUTINE FAST_UnPackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackIceFloe_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackBeamDyn_Data' ! buffers to store meshes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -18627,8 +18629,23 @@ SUBROUTINE FAST_UnPackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - i1_l = LBOUND(OutData%x,1) - i1_u = UBOUND(OutData%x,1) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! x not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%x)) DEALLOCATE(OutData%x) + ALLOCATE(OutData%x(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%x.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%x,2), UBOUND(OutData%x,2) DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -18663,7 +18680,7 @@ SUBROUTINE FAST_UnPackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL IceFloe_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x + CALL BD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1,i2), ErrStat2, ErrMsg2 ) ! x CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -18671,8 +18688,25 @@ SUBROUTINE FAST_UnPackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO - i1_l = LBOUND(OutData%xd,1) - i1_u = UBOUND(OutData%xd,1) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xd not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%xd)) DEALLOCATE(OutData%xd) + ALLOCATE(OutData%xd(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%xd,2), UBOUND(OutData%xd,2) DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -18707,7 +18741,7 @@ SUBROUTINE FAST_UnPackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL IceFloe_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd + CALL BD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1,i2), ErrStat2, ErrMsg2 ) ! xd CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -18715,8 +18749,25 @@ SUBROUTINE FAST_UnPackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO - i1_l = LBOUND(OutData%z,1) - i1_u = UBOUND(OutData%z,1) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! z not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%z)) DEALLOCATE(OutData%z) + ALLOCATE(OutData%z(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%z.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%z,2), UBOUND(OutData%z,2) DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -18751,7 +18802,7 @@ SUBROUTINE FAST_UnPackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL IceFloe_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z + CALL BD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1,i2), ErrStat2, ErrMsg2 ) ! z CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -18759,8 +18810,25 @@ SUBROUTINE FAST_UnPackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO - i1_l = LBOUND(OutData%OtherSt,1) - i1_u = UBOUND(OutData%OtherSt,1) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OtherSt not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%OtherSt)) DEALLOCATE(OutData%OtherSt) + ALLOCATE(OutData%OtherSt(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OtherSt.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%OtherSt,2), UBOUND(OutData%OtherSt,2) DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -18795,7 +18863,7 @@ SUBROUTINE FAST_UnPackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL IceFloe_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt + CALL BD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1,i2), ErrStat2, ErrMsg2 ) ! OtherSt CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -18803,6 +18871,22 @@ SUBROUTINE FAST_UnPackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! p not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%p)) DEALLOCATE(OutData%p) + ALLOCATE(OutData%p(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%p.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%p,1), UBOUND(OutData%p,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -18836,13 +18920,29 @@ SUBROUTINE FAST_UnPackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL IceFloe_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p + CALL BD_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p(i1), ErrStat2, ErrMsg2 ) ! p CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%u)) DEALLOCATE(OutData%u) + ALLOCATE(OutData%u(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%u,1), UBOUND(OutData%u,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -18876,13 +18976,29 @@ SUBROUTINE FAST_UnPackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL IceFloe_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u + CALL BD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u(i1), ErrStat2, ErrMsg2 ) ! u CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! y not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%y)) DEALLOCATE(OutData%y) + ALLOCATE(OutData%y(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%y,1), UBOUND(OutData%y,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -18916,13 +19032,89 @@ SUBROUTINE FAST_UnPackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL IceFloe_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y + CALL BD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y(i1), ErrStat2, ErrMsg2 ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! m not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%m)) DEALLOCATE(OutData%m) + ALLOCATE(OutData%m(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%m.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%m,1), UBOUND(OutData%m,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL BD_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m(i1), ErrStat2, ErrMsg2 ) ! m CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Output not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Output)) DEALLOCATE(OutData%Output) + ALLOCATE(OutData%Output(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%Output,2), UBOUND(OutData%Output,2) + DO i1 = LBOUND(OutData%Output,1), UBOUND(OutData%Output,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -18956,13 +19148,72 @@ SUBROUTINE FAST_UnPackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL IceFloe_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m + CALL BD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%Output(i1,i2), ErrStat2, ErrMsg2 ) ! Output CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! y_interp not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%y_interp)) DEALLOCATE(OutData%y_interp) + ALLOCATE(OutData%y_interp(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_interp.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%y_interp,1), UBOUND(OutData%y_interp,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL BD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_interp(i1), ErrStat2, ErrMsg2 ) ! y_interp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -18970,12 +19221,16 @@ SUBROUTINE FAST_UnPackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 IF (ALLOCATED(OutData%Input)) DEALLOCATE(OutData%Input) - ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) + ALLOCATE(OutData%Input(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) RETURN END IF + DO i2 = LBOUND(OutData%Input,2), UBOUND(OutData%Input,2) DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -19010,7 +19265,7 @@ SUBROUTINE FAST_UnPackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL IceFloe_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input + CALL BD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1,i2), ErrStat2, ErrMsg2 ) ! Input CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -19018,6 +19273,7 @@ SUBROUTINE FAST_UnPackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes not allocated Int_Xferred = Int_Xferred + 1 @@ -19026,27 +19282,27 @@ SUBROUTINE FAST_UnPackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 IF (ALLOCATED(OutData%InputTimes)) DEALLOCATE(OutData%InputTimes) - ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) + ALLOCATE(OutData%InputTimes(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%InputTimes)>0) OutData%InputTimes = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%InputTimes))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%InputTimes) - DEALLOCATE(mask1) + DO i2 = LBOUND(OutData%InputTimes,2), UBOUND(OutData%InputTimes,2) + DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) + OutData%InputTimes(i1,i2) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END DO END IF - END SUBROUTINE FAST_UnPackIceFloe_Data + END SUBROUTINE FAST_UnPackBeamDyn_Data - SUBROUTINE FAST_CopyMAP_Data( SrcMAP_DataData, DstMAP_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MAP_Data), INTENT(INOUT) :: SrcMAP_DataData - TYPE(MAP_Data), INTENT(INOUT) :: DstMAP_DataData + SUBROUTINE FAST_CopyElastoDyn_Data( SrcElastoDyn_DataData, DstElastoDyn_DataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(ElastoDyn_Data), INTENT(INOUT) :: SrcElastoDyn_DataData + TYPE(ElastoDyn_Data), INTENT(INOUT) :: DstElastoDyn_DataData INTEGER(IntKi), INTENT(IN ) :: CtrlCode INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg @@ -19055,109 +19311,139 @@ SUBROUTINE FAST_CopyMAP_Data( SrcMAP_DataData, DstMAP_DataData, CtrlCode, ErrSta INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyMAP_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyElastoDyn_Data' ! ErrStat = ErrID_None ErrMsg = "" - DO i1 = LBOUND(SrcMAP_DataData%x,1), UBOUND(SrcMAP_DataData%x,1) - CALL MAP_CopyContState( SrcMAP_DataData%x(i1), DstMAP_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcElastoDyn_DataData%x,1), UBOUND(SrcElastoDyn_DataData%x,1) + CALL ED_CopyContState( SrcElastoDyn_DataData%x(i1), DstElastoDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO - DO i1 = LBOUND(SrcMAP_DataData%xd,1), UBOUND(SrcMAP_DataData%xd,1) - CALL MAP_CopyDiscState( SrcMAP_DataData%xd(i1), DstMAP_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcElastoDyn_DataData%xd,1), UBOUND(SrcElastoDyn_DataData%xd,1) + CALL ED_CopyDiscState( SrcElastoDyn_DataData%xd(i1), DstElastoDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO - DO i1 = LBOUND(SrcMAP_DataData%z,1), UBOUND(SrcMAP_DataData%z,1) - CALL MAP_CopyConstrState( SrcMAP_DataData%z(i1), DstMAP_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcElastoDyn_DataData%z,1), UBOUND(SrcElastoDyn_DataData%z,1) + CALL ED_CopyConstrState( SrcElastoDyn_DataData%z(i1), DstElastoDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO - CALL MAP_CopyOtherState( SrcMAP_DataData%OtherSt, DstMAP_DataData%OtherSt, CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcElastoDyn_DataData%OtherSt,1), UBOUND(SrcElastoDyn_DataData%OtherSt,1) + CALL ED_CopyOtherState( SrcElastoDyn_DataData%OtherSt(i1), DstElastoDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - CALL MAP_CopyParam( SrcMAP_DataData%p, DstMAP_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) + ENDDO + CALL ED_CopyParam( SrcElastoDyn_DataData%p, DstElastoDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - CALL MAP_CopyInput( SrcMAP_DataData%u, DstMAP_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) + CALL ED_CopyInput( SrcElastoDyn_DataData%u, DstElastoDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - CALL MAP_CopyOutput( SrcMAP_DataData%y, DstMAP_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) + CALL ED_CopyOutput( SrcElastoDyn_DataData%y, DstElastoDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - CALL MAP_CopyOtherState( SrcMAP_DataData%OtherSt_old, DstMAP_DataData%OtherSt_old, CtrlCode, ErrStat2, ErrMsg2 ) + CALL ED_CopyMisc( SrcElastoDyn_DataData%m, DstElastoDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcMAP_DataData%Input)) THEN - i1_l = LBOUND(SrcMAP_DataData%Input,1) - i1_u = UBOUND(SrcMAP_DataData%Input,1) - IF (.NOT. ALLOCATED(DstMAP_DataData%Input)) THEN - ALLOCATE(DstMAP_DataData%Input(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcElastoDyn_DataData%Output)) THEN + i1_l = LBOUND(SrcElastoDyn_DataData%Output,1) + i1_u = UBOUND(SrcElastoDyn_DataData%Output,1) + IF (.NOT. ALLOCATED(DstElastoDyn_DataData%Output)) THEN + ALLOCATE(DstElastoDyn_DataData%Output(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMAP_DataData%Input.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%Output.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DO i1 = LBOUND(SrcMAP_DataData%Input,1), UBOUND(SrcMAP_DataData%Input,1) - CALL MAP_CopyInput( SrcMAP_DataData%Input(i1), DstMAP_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcElastoDyn_DataData%Output,1), UBOUND(SrcElastoDyn_DataData%Output,1) + CALL ED_CopyOutput( SrcElastoDyn_DataData%Output(i1), DstElastoDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO ENDIF -IF (ALLOCATED(SrcMAP_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcMAP_DataData%InputTimes,1) - i1_u = UBOUND(SrcMAP_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstMAP_DataData%InputTimes)) THEN - ALLOCATE(DstMAP_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) + CALL ED_CopyOutput( SrcElastoDyn_DataData%y_interp, DstElastoDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcElastoDyn_DataData%Input)) THEN + i1_l = LBOUND(SrcElastoDyn_DataData%Input,1) + i1_u = UBOUND(SrcElastoDyn_DataData%Input,1) + IF (.NOT. ALLOCATED(DstElastoDyn_DataData%Input)) THEN + ALLOCATE(DstElastoDyn_DataData%Input(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMAP_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstMAP_DataData%InputTimes = SrcMAP_DataData%InputTimes + DO i1 = LBOUND(SrcElastoDyn_DataData%Input,1), UBOUND(SrcElastoDyn_DataData%Input,1) + CALL ED_CopyInput( SrcElastoDyn_DataData%Input(i1), DstElastoDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF - END SUBROUTINE FAST_CopyMAP_Data +IF (ALLOCATED(SrcElastoDyn_DataData%InputTimes)) THEN + i1_l = LBOUND(SrcElastoDyn_DataData%InputTimes,1) + i1_u = UBOUND(SrcElastoDyn_DataData%InputTimes,1) + IF (.NOT. ALLOCATED(DstElastoDyn_DataData%InputTimes)) THEN + ALLOCATE(DstElastoDyn_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstElastoDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstElastoDyn_DataData%InputTimes = SrcElastoDyn_DataData%InputTimes +ENDIF + END SUBROUTINE FAST_CopyElastoDyn_Data - SUBROUTINE FAST_DestroyMAP_Data( MAP_DataData, ErrStat, ErrMsg ) - TYPE(MAP_Data), INTENT(INOUT) :: MAP_DataData + SUBROUTINE FAST_DestroyElastoDyn_Data( ElastoDyn_DataData, ErrStat, ErrMsg ) + TYPE(ElastoDyn_Data), INTENT(INOUT) :: ElastoDyn_DataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyMAP_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyElastoDyn_Data' INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 ! ErrStat = ErrID_None ErrMsg = "" -DO i1 = LBOUND(MAP_DataData%x,1), UBOUND(MAP_DataData%x,1) - CALL MAP_DestroyContState( MAP_DataData%x(i1), ErrStat, ErrMsg ) +DO i1 = LBOUND(ElastoDyn_DataData%x,1), UBOUND(ElastoDyn_DataData%x,1) + CALL ED_DestroyContState( ElastoDyn_DataData%x(i1), ErrStat, ErrMsg ) ENDDO -DO i1 = LBOUND(MAP_DataData%xd,1), UBOUND(MAP_DataData%xd,1) - CALL MAP_DestroyDiscState( MAP_DataData%xd(i1), ErrStat, ErrMsg ) +DO i1 = LBOUND(ElastoDyn_DataData%xd,1), UBOUND(ElastoDyn_DataData%xd,1) + CALL ED_DestroyDiscState( ElastoDyn_DataData%xd(i1), ErrStat, ErrMsg ) ENDDO -DO i1 = LBOUND(MAP_DataData%z,1), UBOUND(MAP_DataData%z,1) - CALL MAP_DestroyConstrState( MAP_DataData%z(i1), ErrStat, ErrMsg ) +DO i1 = LBOUND(ElastoDyn_DataData%z,1), UBOUND(ElastoDyn_DataData%z,1) + CALL ED_DestroyConstrState( ElastoDyn_DataData%z(i1), ErrStat, ErrMsg ) ENDDO - CALL MAP_DestroyOtherState( MAP_DataData%OtherSt, ErrStat, ErrMsg ) - CALL MAP_DestroyParam( MAP_DataData%p, ErrStat, ErrMsg ) - CALL MAP_DestroyInput( MAP_DataData%u, ErrStat, ErrMsg ) - CALL MAP_DestroyOutput( MAP_DataData%y, ErrStat, ErrMsg ) - CALL MAP_DestroyOtherState( MAP_DataData%OtherSt_old, ErrStat, ErrMsg ) -IF (ALLOCATED(MAP_DataData%Input)) THEN -DO i1 = LBOUND(MAP_DataData%Input,1), UBOUND(MAP_DataData%Input,1) - CALL MAP_DestroyInput( MAP_DataData%Input(i1), ErrStat, ErrMsg ) +DO i1 = LBOUND(ElastoDyn_DataData%OtherSt,1), UBOUND(ElastoDyn_DataData%OtherSt,1) + CALL ED_DestroyOtherState( ElastoDyn_DataData%OtherSt(i1), ErrStat, ErrMsg ) ENDDO - DEALLOCATE(MAP_DataData%Input) + CALL ED_DestroyParam( ElastoDyn_DataData%p, ErrStat, ErrMsg ) + CALL ED_DestroyInput( ElastoDyn_DataData%u, ErrStat, ErrMsg ) + CALL ED_DestroyOutput( ElastoDyn_DataData%y, ErrStat, ErrMsg ) + CALL ED_DestroyMisc( ElastoDyn_DataData%m, ErrStat, ErrMsg ) +IF (ALLOCATED(ElastoDyn_DataData%Output)) THEN +DO i1 = LBOUND(ElastoDyn_DataData%Output,1), UBOUND(ElastoDyn_DataData%Output,1) + CALL ED_DestroyOutput( ElastoDyn_DataData%Output(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(ElastoDyn_DataData%Output) ENDIF -IF (ALLOCATED(MAP_DataData%InputTimes)) THEN - DEALLOCATE(MAP_DataData%InputTimes) + CALL ED_DestroyOutput( ElastoDyn_DataData%y_interp, ErrStat, ErrMsg ) +IF (ALLOCATED(ElastoDyn_DataData%Input)) THEN +DO i1 = LBOUND(ElastoDyn_DataData%Input,1), UBOUND(ElastoDyn_DataData%Input,1) + CALL ED_DestroyInput( ElastoDyn_DataData%Input(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(ElastoDyn_DataData%Input) ENDIF - END SUBROUTINE FAST_DestroyMAP_Data +IF (ALLOCATED(ElastoDyn_DataData%InputTimes)) THEN + DEALLOCATE(ElastoDyn_DataData%InputTimes) +ENDIF + END SUBROUTINE FAST_DestroyElastoDyn_Data - SUBROUTINE FAST_PackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + SUBROUTINE FAST_PackElastoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(MAP_Data), INTENT(IN) :: InData + TYPE(ElastoDyn_Data), INTENT(IN) :: InData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly @@ -19172,7 +19458,7 @@ SUBROUTINE FAST_PackMAP_Data( 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 = 'FAST_PackMAP_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackElastoDyn_Data' ! buffers to store subtypes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -19191,7 +19477,7 @@ SUBROUTINE FAST_PackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs ! Allocate buffers for subtypes, if any (we'll get sizes from these) DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL MAP_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x + CALL ED_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -19210,7 +19496,7 @@ SUBROUTINE FAST_PackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs END DO DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL MAP_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd + CALL ED_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -19229,7 +19515,7 @@ SUBROUTINE FAST_PackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs END DO DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL MAP_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z + CALL ED_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -19246,8 +19532,9 @@ SUBROUTINE FAST_PackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs DEALLOCATE(Int_Buf) END IF END DO + DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL MAP_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt, ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt + CALL ED_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -19263,8 +19550,9 @@ SUBROUTINE FAST_PackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF + END DO Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL MAP_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p + CALL ED_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -19281,7 +19569,7 @@ SUBROUTINE FAST_PackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL MAP_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u + CALL ED_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -19298,7 +19586,7 @@ SUBROUTINE FAST_PackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL MAP_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y + CALL ED_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -19314,20 +19602,60 @@ SUBROUTINE FAST_PackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF - Int_BufSz = Int_BufSz + 3 ! OtherSt_old: size of buffers for each call to pack subtype - CALL MAP_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_old, ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt_old + Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype + CALL ED_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! OtherSt_old + IF(ALLOCATED(Re_Buf)) THEN ! m Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! OtherSt_old + IF(ALLOCATED(Db_Buf)) THEN ! m Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! OtherSt_old + IF(ALLOCATED(Int_Buf)) THEN ! m + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! Output allocated yes/no + IF ( ALLOCATED(InData%Output) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Output upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) + Int_BufSz = Int_BufSz + 3 ! Output: size of buffers for each call to pack subtype + CALL ED_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Output + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Output + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Output + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Output + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 3 ! y_interp: size of buffers for each call to pack subtype + CALL ED_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, .TRUE. ) ! y_interp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! y_interp + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! y_interp + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! y_interp Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF @@ -19336,7 +19664,7 @@ SUBROUTINE FAST_PackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL MAP_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input + CALL ED_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -19387,7 +19715,7 @@ SUBROUTINE FAST_PackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Int_Xferred = 1 DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL MAP_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x + CALL ED_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -19417,7 +19745,7 @@ SUBROUTINE FAST_PackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs ENDIF END DO DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL MAP_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd + CALL ED_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -19447,7 +19775,7 @@ SUBROUTINE FAST_PackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs ENDIF END DO DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL MAP_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z + CALL ED_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -19476,7 +19804,8 @@ SUBROUTINE FAST_PackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF END DO - CALL MAP_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt, ErrStat2, ErrMsg2, OnlySize ) ! OtherSt + DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) + CALL ED_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -19504,7 +19833,8 @@ SUBROUTINE FAST_PackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL MAP_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p + END DO + CALL ED_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -19532,7 +19862,7 @@ SUBROUTINE FAST_PackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL MAP_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u + CALL ED_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -19560,7 +19890,7 @@ SUBROUTINE FAST_PackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL MAP_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y + CALL ED_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -19588,7 +19918,76 @@ SUBROUTINE FAST_PackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL MAP_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_old, ErrStat2, ErrMsg2, OnlySize ) ! OtherSt_old + CALL ED_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%Output) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Output,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Output,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) + CALL ED_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, OnlySize ) ! Output + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + CALL ED_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, OnlySize ) ! y_interp CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -19627,7 +20026,7 @@ SUBROUTINE FAST_PackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL MAP_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input + CALL ED_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -19667,16 +20066,18 @@ SUBROUTINE FAST_PackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%InputTimes)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%InputTimes))-1 ) = PACK(InData%InputTimes,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%InputTimes) + DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) + DbKiBuf(Db_Xferred) = InData%InputTimes(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF - END SUBROUTINE FAST_PackMAP_Data + END SUBROUTINE FAST_PackElastoDyn_Data - SUBROUTINE FAST_UnPackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + SUBROUTINE FAST_UnPackElastoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(MAP_Data), INTENT(INOUT) :: OutData + TYPE(ElastoDyn_Data), INTENT(INOUT) :: OutData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local variables @@ -19685,16 +20086,10 @@ SUBROUTINE FAST_UnPackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackMAP_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackElastoDyn_Data' ! buffers to store meshes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -19741,7 +20136,7 @@ SUBROUTINE FAST_UnPackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MAP_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x + CALL ED_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -19785,7 +20180,7 @@ SUBROUTINE FAST_UnPackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MAP_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd + CALL ED_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -19829,7 +20224,7 @@ SUBROUTINE FAST_UnPackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MAP_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z + CALL ED_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -19837,6 +20232,9 @@ SUBROUTINE FAST_UnPackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO + i1_l = LBOUND(OutData%OtherSt,1) + i1_u = UBOUND(OutData%OtherSt,1) + DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -19870,13 +20268,14 @@ SUBROUTINE FAST_UnPackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MAP_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt, ErrStat2, ErrMsg2 ) ! OtherSt + CALL ED_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -19910,7 +20309,7 @@ SUBROUTINE FAST_UnPackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MAP_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p + CALL ED_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -19950,7 +20349,7 @@ SUBROUTINE FAST_UnPackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MAP_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u + CALL ED_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -19990,7 +20389,7 @@ SUBROUTINE FAST_UnPackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MAP_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y + CALL ED_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -20030,7 +20429,103 @@ SUBROUTINE FAST_UnPackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MAP_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_old, ErrStat2, ErrMsg2 ) ! OtherSt_old + CALL ED_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Output not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Output)) DEALLOCATE(OutData%Output) + ALLOCATE(OutData%Output(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Output,1), UBOUND(OutData%Output,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL ED_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%Output(i1), ErrStat2, ErrMsg2 ) ! Output + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL ED_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_interp, ErrStat2, ErrMsg2 ) ! y_interp CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -20084,7 +20579,7 @@ SUBROUTINE FAST_UnPackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MAP_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input + CALL ED_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -20106,21 +20601,16 @@ SUBROUTINE FAST_UnPackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%InputTimes)>0) OutData%InputTimes = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%InputTimes))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%InputTimes) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) + OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO END IF - END SUBROUTINE FAST_UnPackMAP_Data + END SUBROUTINE FAST_UnPackElastoDyn_Data - SUBROUTINE FAST_CopyFEAMooring_Data( SrcFEAMooring_DataData, DstFEAMooring_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FEAMooring_Data), INTENT(INOUT) :: SrcFEAMooring_DataData - TYPE(FEAMooring_Data), INTENT(INOUT) :: DstFEAMooring_DataData + SUBROUTINE FAST_CopyServoDyn_Data( SrcServoDyn_DataData, DstServoDyn_DataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(ServoDyn_Data), INTENT(INOUT) :: SrcServoDyn_DataData + TYPE(ServoDyn_Data), INTENT(INOUT) :: DstServoDyn_DataData INTEGER(IntKi), INTENT(IN ) :: CtrlCode INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg @@ -20129,113 +20619,139 @@ SUBROUTINE FAST_CopyFEAMooring_Data( SrcFEAMooring_DataData, DstFEAMooring_DataD INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyFEAMooring_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyServoDyn_Data' ! ErrStat = ErrID_None ErrMsg = "" - DO i1 = LBOUND(SrcFEAMooring_DataData%x,1), UBOUND(SrcFEAMooring_DataData%x,1) - CALL FEAM_CopyContState( SrcFEAMooring_DataData%x(i1), DstFEAMooring_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcServoDyn_DataData%x,1), UBOUND(SrcServoDyn_DataData%x,1) + CALL SrvD_CopyContState( SrcServoDyn_DataData%x(i1), DstServoDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO - DO i1 = LBOUND(SrcFEAMooring_DataData%xd,1), UBOUND(SrcFEAMooring_DataData%xd,1) - CALL FEAM_CopyDiscState( SrcFEAMooring_DataData%xd(i1), DstFEAMooring_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcServoDyn_DataData%xd,1), UBOUND(SrcServoDyn_DataData%xd,1) + CALL SrvD_CopyDiscState( SrcServoDyn_DataData%xd(i1), DstServoDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO - DO i1 = LBOUND(SrcFEAMooring_DataData%z,1), UBOUND(SrcFEAMooring_DataData%z,1) - CALL FEAM_CopyConstrState( SrcFEAMooring_DataData%z(i1), DstFEAMooring_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcServoDyn_DataData%z,1), UBOUND(SrcServoDyn_DataData%z,1) + CALL SrvD_CopyConstrState( SrcServoDyn_DataData%z(i1), DstServoDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO - DO i1 = LBOUND(SrcFEAMooring_DataData%OtherSt,1), UBOUND(SrcFEAMooring_DataData%OtherSt,1) - CALL FEAM_CopyOtherState( SrcFEAMooring_DataData%OtherSt(i1), DstFEAMooring_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcServoDyn_DataData%OtherSt,1), UBOUND(SrcServoDyn_DataData%OtherSt,1) + CALL SrvD_CopyOtherState( SrcServoDyn_DataData%OtherSt(i1), DstServoDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO - CALL FEAM_CopyParam( SrcFEAMooring_DataData%p, DstFEAMooring_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SrvD_CopyParam( SrcServoDyn_DataData%p, DstServoDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - CALL FEAM_CopyInput( SrcFEAMooring_DataData%u, DstFEAMooring_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SrvD_CopyInput( SrcServoDyn_DataData%u, DstServoDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - CALL FEAM_CopyOutput( SrcFEAMooring_DataData%y, DstFEAMooring_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SrvD_CopyOutput( SrcServoDyn_DataData%y, DstServoDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - CALL FEAM_CopyMisc( SrcFEAMooring_DataData%m, DstFEAMooring_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SrvD_CopyMisc( SrcServoDyn_DataData%m, DstServoDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcFEAMooring_DataData%Input)) THEN - i1_l = LBOUND(SrcFEAMooring_DataData%Input,1) - i1_u = UBOUND(SrcFEAMooring_DataData%Input,1) - IF (.NOT. ALLOCATED(DstFEAMooring_DataData%Input)) THEN - ALLOCATE(DstFEAMooring_DataData%Input(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcServoDyn_DataData%Output)) THEN + i1_l = LBOUND(SrcServoDyn_DataData%Output,1) + i1_u = UBOUND(SrcServoDyn_DataData%Output,1) + IF (.NOT. ALLOCATED(DstServoDyn_DataData%Output)) THEN + ALLOCATE(DstServoDyn_DataData%Output(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstFEAMooring_DataData%Input.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstServoDyn_DataData%Output.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DO i1 = LBOUND(SrcFEAMooring_DataData%Input,1), UBOUND(SrcFEAMooring_DataData%Input,1) - CALL FEAM_CopyInput( SrcFEAMooring_DataData%Input(i1), DstFEAMooring_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcServoDyn_DataData%Output,1), UBOUND(SrcServoDyn_DataData%Output,1) + CALL SrvD_CopyOutput( SrcServoDyn_DataData%Output(i1), DstServoDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO ENDIF -IF (ALLOCATED(SrcFEAMooring_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcFEAMooring_DataData%InputTimes,1) - i1_u = UBOUND(SrcFEAMooring_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstFEAMooring_DataData%InputTimes)) THEN - ALLOCATE(DstFEAMooring_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) + CALL SrvD_CopyOutput( SrcServoDyn_DataData%y_interp, DstServoDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcServoDyn_DataData%Input)) THEN + i1_l = LBOUND(SrcServoDyn_DataData%Input,1) + i1_u = UBOUND(SrcServoDyn_DataData%Input,1) + IF (.NOT. ALLOCATED(DstServoDyn_DataData%Input)) THEN + ALLOCATE(DstServoDyn_DataData%Input(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstFEAMooring_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstServoDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstFEAMooring_DataData%InputTimes = SrcFEAMooring_DataData%InputTimes + DO i1 = LBOUND(SrcServoDyn_DataData%Input,1), UBOUND(SrcServoDyn_DataData%Input,1) + CALL SrvD_CopyInput( SrcServoDyn_DataData%Input(i1), DstServoDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF - END SUBROUTINE FAST_CopyFEAMooring_Data +IF (ALLOCATED(SrcServoDyn_DataData%InputTimes)) THEN + i1_l = LBOUND(SrcServoDyn_DataData%InputTimes,1) + i1_u = UBOUND(SrcServoDyn_DataData%InputTimes,1) + IF (.NOT. ALLOCATED(DstServoDyn_DataData%InputTimes)) THEN + ALLOCATE(DstServoDyn_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstServoDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstServoDyn_DataData%InputTimes = SrcServoDyn_DataData%InputTimes +ENDIF + END SUBROUTINE FAST_CopyServoDyn_Data - SUBROUTINE FAST_DestroyFEAMooring_Data( FEAMooring_DataData, ErrStat, ErrMsg ) - TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAMooring_DataData + SUBROUTINE FAST_DestroyServoDyn_Data( ServoDyn_DataData, ErrStat, ErrMsg ) + TYPE(ServoDyn_Data), INTENT(INOUT) :: ServoDyn_DataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyFEAMooring_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyServoDyn_Data' INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 ! ErrStat = ErrID_None ErrMsg = "" -DO i1 = LBOUND(FEAMooring_DataData%x,1), UBOUND(FEAMooring_DataData%x,1) - CALL FEAM_DestroyContState( FEAMooring_DataData%x(i1), ErrStat, ErrMsg ) +DO i1 = LBOUND(ServoDyn_DataData%x,1), UBOUND(ServoDyn_DataData%x,1) + CALL SrvD_DestroyContState( ServoDyn_DataData%x(i1), ErrStat, ErrMsg ) ENDDO -DO i1 = LBOUND(FEAMooring_DataData%xd,1), UBOUND(FEAMooring_DataData%xd,1) - CALL FEAM_DestroyDiscState( FEAMooring_DataData%xd(i1), ErrStat, ErrMsg ) +DO i1 = LBOUND(ServoDyn_DataData%xd,1), UBOUND(ServoDyn_DataData%xd,1) + CALL SrvD_DestroyDiscState( ServoDyn_DataData%xd(i1), ErrStat, ErrMsg ) ENDDO -DO i1 = LBOUND(FEAMooring_DataData%z,1), UBOUND(FEAMooring_DataData%z,1) - CALL FEAM_DestroyConstrState( FEAMooring_DataData%z(i1), ErrStat, ErrMsg ) +DO i1 = LBOUND(ServoDyn_DataData%z,1), UBOUND(ServoDyn_DataData%z,1) + CALL SrvD_DestroyConstrState( ServoDyn_DataData%z(i1), ErrStat, ErrMsg ) ENDDO -DO i1 = LBOUND(FEAMooring_DataData%OtherSt,1), UBOUND(FEAMooring_DataData%OtherSt,1) - CALL FEAM_DestroyOtherState( FEAMooring_DataData%OtherSt(i1), ErrStat, ErrMsg ) +DO i1 = LBOUND(ServoDyn_DataData%OtherSt,1), UBOUND(ServoDyn_DataData%OtherSt,1) + CALL SrvD_DestroyOtherState( ServoDyn_DataData%OtherSt(i1), ErrStat, ErrMsg ) ENDDO - CALL FEAM_DestroyParam( FEAMooring_DataData%p, ErrStat, ErrMsg ) - CALL FEAM_DestroyInput( FEAMooring_DataData%u, ErrStat, ErrMsg ) - CALL FEAM_DestroyOutput( FEAMooring_DataData%y, ErrStat, ErrMsg ) - CALL FEAM_DestroyMisc( FEAMooring_DataData%m, ErrStat, ErrMsg ) -IF (ALLOCATED(FEAMooring_DataData%Input)) THEN -DO i1 = LBOUND(FEAMooring_DataData%Input,1), UBOUND(FEAMooring_DataData%Input,1) - CALL FEAM_DestroyInput( FEAMooring_DataData%Input(i1), ErrStat, ErrMsg ) + CALL SrvD_DestroyParam( ServoDyn_DataData%p, ErrStat, ErrMsg ) + CALL SrvD_DestroyInput( ServoDyn_DataData%u, ErrStat, ErrMsg ) + CALL SrvD_DestroyOutput( ServoDyn_DataData%y, ErrStat, ErrMsg ) + CALL SrvD_DestroyMisc( ServoDyn_DataData%m, ErrStat, ErrMsg ) +IF (ALLOCATED(ServoDyn_DataData%Output)) THEN +DO i1 = LBOUND(ServoDyn_DataData%Output,1), UBOUND(ServoDyn_DataData%Output,1) + CALL SrvD_DestroyOutput( ServoDyn_DataData%Output(i1), ErrStat, ErrMsg ) ENDDO - DEALLOCATE(FEAMooring_DataData%Input) + DEALLOCATE(ServoDyn_DataData%Output) ENDIF -IF (ALLOCATED(FEAMooring_DataData%InputTimes)) THEN - DEALLOCATE(FEAMooring_DataData%InputTimes) + CALL SrvD_DestroyOutput( ServoDyn_DataData%y_interp, ErrStat, ErrMsg ) +IF (ALLOCATED(ServoDyn_DataData%Input)) THEN +DO i1 = LBOUND(ServoDyn_DataData%Input,1), UBOUND(ServoDyn_DataData%Input,1) + CALL SrvD_DestroyInput( ServoDyn_DataData%Input(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(ServoDyn_DataData%Input) ENDIF - END SUBROUTINE FAST_DestroyFEAMooring_Data +IF (ALLOCATED(ServoDyn_DataData%InputTimes)) THEN + DEALLOCATE(ServoDyn_DataData%InputTimes) +ENDIF + END SUBROUTINE FAST_DestroyServoDyn_Data - SUBROUTINE FAST_PackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + SUBROUTINE FAST_PackServoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FEAMooring_Data), INTENT(IN) :: InData + TYPE(ServoDyn_Data), INTENT(IN) :: InData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly @@ -20250,7 +20766,7 @@ SUBROUTINE FAST_PackFEAMooring_Data( 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 = 'FAST_PackFEAMooring_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackServoDyn_Data' ! buffers to store subtypes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -20269,7 +20785,7 @@ SUBROUTINE FAST_PackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat ! Allocate buffers for subtypes, if any (we'll get sizes from these) DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL FEAM_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x + CALL SrvD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -20288,7 +20804,7 @@ SUBROUTINE FAST_PackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat END DO DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL FEAM_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd + CALL SrvD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -20307,7 +20823,7 @@ SUBROUTINE FAST_PackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat END DO DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL FEAM_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z + CALL SrvD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -20326,7 +20842,7 @@ SUBROUTINE FAST_PackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat END DO DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL FEAM_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt + CALL SrvD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -20344,7 +20860,7 @@ SUBROUTINE FAST_PackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat END IF END DO Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL FEAM_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p + CALL SrvD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -20361,7 +20877,7 @@ SUBROUTINE FAST_PackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL FEAM_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u + CALL SrvD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -20378,7 +20894,7 @@ SUBROUTINE FAST_PackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL FEAM_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y + CALL SrvD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -20395,7 +20911,7 @@ SUBROUTINE FAST_PackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL FEAM_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m + CALL SrvD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -20411,12 +20927,52 @@ SUBROUTINE FAST_PackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF + Int_BufSz = Int_BufSz + 1 ! Output allocated yes/no + IF ( ALLOCATED(InData%Output) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Output upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) + Int_BufSz = Int_BufSz + 3 ! Output: size of buffers for each call to pack subtype + CALL SrvD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Output + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Output + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Output + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Output + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 3 ! y_interp: size of buffers for each call to pack subtype + CALL SrvD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, .TRUE. ) ! y_interp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! y_interp + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! y_interp + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! y_interp + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no IF ( ALLOCATED(InData%Input) ) THEN Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL FEAM_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input + CALL SrvD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -20467,7 +21023,7 @@ SUBROUTINE FAST_PackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat Int_Xferred = 1 DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL FEAM_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x + CALL SrvD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -20497,7 +21053,7 @@ SUBROUTINE FAST_PackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat ENDIF END DO DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL FEAM_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd + CALL SrvD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -20527,7 +21083,7 @@ SUBROUTINE FAST_PackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat ENDIF END DO DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL FEAM_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z + CALL SrvD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -20557,7 +21113,7 @@ SUBROUTINE FAST_PackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat ENDIF END DO DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL FEAM_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt + CALL SrvD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -20586,7 +21142,7 @@ SUBROUTINE FAST_PackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF END DO - CALL FEAM_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p + CALL SrvD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -20614,7 +21170,7 @@ SUBROUTINE FAST_PackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL FEAM_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u + CALL SrvD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -20642,7 +21198,7 @@ SUBROUTINE FAST_PackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL FEAM_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y + CALL SrvD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -20670,7 +21226,76 @@ SUBROUTINE FAST_PackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL FEAM_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m + CALL SrvD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%Output) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Output,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Output,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) + CALL SrvD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, OnlySize ) ! Output + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + CALL SrvD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, OnlySize ) ! y_interp CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -20709,7 +21334,7 @@ SUBROUTINE FAST_PackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL FEAM_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input + CALL SrvD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -20749,16 +21374,18 @@ SUBROUTINE FAST_PackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%InputTimes)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%InputTimes))-1 ) = PACK(InData%InputTimes,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%InputTimes) + DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) + DbKiBuf(Db_Xferred) = InData%InputTimes(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF - END SUBROUTINE FAST_PackFEAMooring_Data + END SUBROUTINE FAST_PackServoDyn_Data - SUBROUTINE FAST_UnPackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + SUBROUTINE FAST_UnPackServoDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FEAMooring_Data), INTENT(INOUT) :: OutData + TYPE(ServoDyn_Data), INTENT(INOUT) :: OutData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local variables @@ -20767,16 +21394,10 @@ SUBROUTINE FAST_UnPackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackFEAMooring_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackServoDyn_Data' ! buffers to store meshes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -20823,7 +21444,7 @@ SUBROUTINE FAST_UnPackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL FEAM_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x + CALL SrvD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -20867,7 +21488,7 @@ SUBROUTINE FAST_UnPackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL FEAM_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd + CALL SrvD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -20911,7 +21532,7 @@ SUBROUTINE FAST_UnPackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL FEAM_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z + CALL SrvD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -20955,7 +21576,7 @@ SUBROUTINE FAST_UnPackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL FEAM_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt + CALL SrvD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -20996,7 +21617,7 @@ SUBROUTINE FAST_UnPackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL FEAM_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p + CALL SrvD_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -21036,7 +21657,7 @@ SUBROUTINE FAST_UnPackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL FEAM_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u + CALL SrvD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -21076,7 +21697,7 @@ SUBROUTINE FAST_UnPackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL FEAM_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y + CALL SrvD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -21116,7 +21737,103 @@ SUBROUTINE FAST_UnPackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL FEAM_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m + CALL SrvD_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Output not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Output)) DEALLOCATE(OutData%Output) + ALLOCATE(OutData%Output(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Output,1), UBOUND(OutData%Output,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SrvD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%Output(i1), ErrStat2, ErrMsg2 ) ! Output + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SrvD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_interp, ErrStat2, ErrMsg2 ) ! y_interp CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -21170,7 +21887,7 @@ SUBROUTINE FAST_UnPackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL FEAM_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input + CALL SrvD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -21192,21 +21909,16 @@ SUBROUTINE FAST_UnPackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%InputTimes)>0) OutData%InputTimes = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%InputTimes))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%InputTimes) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) + OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO END IF - END SUBROUTINE FAST_UnPackFEAMooring_Data + END SUBROUTINE FAST_UnPackServoDyn_Data - SUBROUTINE FAST_CopyMoorDyn_Data( SrcMoorDyn_DataData, DstMoorDyn_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(MoorDyn_Data), INTENT(INOUT) :: SrcMoorDyn_DataData - TYPE(MoorDyn_Data), INTENT(INOUT) :: DstMoorDyn_DataData + SUBROUTINE FAST_CopyAeroDyn14_Data( SrcAeroDyn14_DataData, DstAeroDyn14_DataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(AeroDyn14_Data), INTENT(INOUT) :: SrcAeroDyn14_DataData + TYPE(AeroDyn14_Data), INTENT(INOUT) :: DstAeroDyn14_DataData INTEGER(IntKi), INTENT(IN ) :: CtrlCode INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg @@ -21215,113 +21927,113 @@ SUBROUTINE FAST_CopyMoorDyn_Data( SrcMoorDyn_DataData, DstMoorDyn_DataData, Ctrl INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyMoorDyn_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyAeroDyn14_Data' ! ErrStat = ErrID_None ErrMsg = "" - DO i1 = LBOUND(SrcMoorDyn_DataData%x,1), UBOUND(SrcMoorDyn_DataData%x,1) - CALL MD_CopyContState( SrcMoorDyn_DataData%x(i1), DstMoorDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcAeroDyn14_DataData%x,1), UBOUND(SrcAeroDyn14_DataData%x,1) + CALL AD14_CopyContState( SrcAeroDyn14_DataData%x(i1), DstAeroDyn14_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO - DO i1 = LBOUND(SrcMoorDyn_DataData%xd,1), UBOUND(SrcMoorDyn_DataData%xd,1) - CALL MD_CopyDiscState( SrcMoorDyn_DataData%xd(i1), DstMoorDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcAeroDyn14_DataData%xd,1), UBOUND(SrcAeroDyn14_DataData%xd,1) + CALL AD14_CopyDiscState( SrcAeroDyn14_DataData%xd(i1), DstAeroDyn14_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO - DO i1 = LBOUND(SrcMoorDyn_DataData%z,1), UBOUND(SrcMoorDyn_DataData%z,1) - CALL MD_CopyConstrState( SrcMoorDyn_DataData%z(i1), DstMoorDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcAeroDyn14_DataData%z,1), UBOUND(SrcAeroDyn14_DataData%z,1) + CALL AD14_CopyConstrState( SrcAeroDyn14_DataData%z(i1), DstAeroDyn14_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO - DO i1 = LBOUND(SrcMoorDyn_DataData%OtherSt,1), UBOUND(SrcMoorDyn_DataData%OtherSt,1) - CALL MD_CopyOtherState( SrcMoorDyn_DataData%OtherSt(i1), DstMoorDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcAeroDyn14_DataData%OtherSt,1), UBOUND(SrcAeroDyn14_DataData%OtherSt,1) + CALL AD14_CopyOtherState( SrcAeroDyn14_DataData%OtherSt(i1), DstAeroDyn14_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO - CALL MD_CopyParam( SrcMoorDyn_DataData%p, DstMoorDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) + CALL AD14_CopyParam( SrcAeroDyn14_DataData%p, DstAeroDyn14_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - CALL MD_CopyInput( SrcMoorDyn_DataData%u, DstMoorDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) + CALL AD14_CopyInput( SrcAeroDyn14_DataData%u, DstAeroDyn14_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - CALL MD_CopyOutput( SrcMoorDyn_DataData%y, DstMoorDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) + CALL AD14_CopyOutput( SrcAeroDyn14_DataData%y, DstAeroDyn14_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - CALL MD_CopyMisc( SrcMoorDyn_DataData%m, DstMoorDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) + CALL AD14_CopyMisc( SrcAeroDyn14_DataData%m, DstAeroDyn14_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcMoorDyn_DataData%Input)) THEN - i1_l = LBOUND(SrcMoorDyn_DataData%Input,1) - i1_u = UBOUND(SrcMoorDyn_DataData%Input,1) - IF (.NOT. ALLOCATED(DstMoorDyn_DataData%Input)) THEN - ALLOCATE(DstMoorDyn_DataData%Input(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcAeroDyn14_DataData%Input)) THEN + i1_l = LBOUND(SrcAeroDyn14_DataData%Input,1) + i1_u = UBOUND(SrcAeroDyn14_DataData%Input,1) + IF (.NOT. ALLOCATED(DstAeroDyn14_DataData%Input)) THEN + ALLOCATE(DstAeroDyn14_DataData%Input(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMoorDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn14_DataData%Input.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DO i1 = LBOUND(SrcMoorDyn_DataData%Input,1), UBOUND(SrcMoorDyn_DataData%Input,1) - CALL MD_CopyInput( SrcMoorDyn_DataData%Input(i1), DstMoorDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcAeroDyn14_DataData%Input,1), UBOUND(SrcAeroDyn14_DataData%Input,1) + CALL AD14_CopyInput( SrcAeroDyn14_DataData%Input(i1), DstAeroDyn14_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO ENDIF -IF (ALLOCATED(SrcMoorDyn_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcMoorDyn_DataData%InputTimes,1) - i1_u = UBOUND(SrcMoorDyn_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstMoorDyn_DataData%InputTimes)) THEN - ALLOCATE(DstMoorDyn_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcAeroDyn14_DataData%InputTimes)) THEN + i1_l = LBOUND(SrcAeroDyn14_DataData%InputTimes,1) + i1_u = UBOUND(SrcAeroDyn14_DataData%InputTimes,1) + IF (.NOT. ALLOCATED(DstAeroDyn14_DataData%InputTimes)) THEN + ALLOCATE(DstAeroDyn14_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMoorDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn14_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstMoorDyn_DataData%InputTimes = SrcMoorDyn_DataData%InputTimes + DstAeroDyn14_DataData%InputTimes = SrcAeroDyn14_DataData%InputTimes ENDIF - END SUBROUTINE FAST_CopyMoorDyn_Data + END SUBROUTINE FAST_CopyAeroDyn14_Data - SUBROUTINE FAST_DestroyMoorDyn_Data( MoorDyn_DataData, ErrStat, ErrMsg ) - TYPE(MoorDyn_Data), INTENT(INOUT) :: MoorDyn_DataData + SUBROUTINE FAST_DestroyAeroDyn14_Data( AeroDyn14_DataData, ErrStat, ErrMsg ) + TYPE(AeroDyn14_Data), INTENT(INOUT) :: AeroDyn14_DataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyMoorDyn_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyAeroDyn14_Data' INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 ! ErrStat = ErrID_None ErrMsg = "" -DO i1 = LBOUND(MoorDyn_DataData%x,1), UBOUND(MoorDyn_DataData%x,1) - CALL MD_DestroyContState( MoorDyn_DataData%x(i1), ErrStat, ErrMsg ) +DO i1 = LBOUND(AeroDyn14_DataData%x,1), UBOUND(AeroDyn14_DataData%x,1) + CALL AD14_DestroyContState( AeroDyn14_DataData%x(i1), ErrStat, ErrMsg ) ENDDO -DO i1 = LBOUND(MoorDyn_DataData%xd,1), UBOUND(MoorDyn_DataData%xd,1) - CALL MD_DestroyDiscState( MoorDyn_DataData%xd(i1), ErrStat, ErrMsg ) +DO i1 = LBOUND(AeroDyn14_DataData%xd,1), UBOUND(AeroDyn14_DataData%xd,1) + CALL AD14_DestroyDiscState( AeroDyn14_DataData%xd(i1), ErrStat, ErrMsg ) ENDDO -DO i1 = LBOUND(MoorDyn_DataData%z,1), UBOUND(MoorDyn_DataData%z,1) - CALL MD_DestroyConstrState( MoorDyn_DataData%z(i1), ErrStat, ErrMsg ) +DO i1 = LBOUND(AeroDyn14_DataData%z,1), UBOUND(AeroDyn14_DataData%z,1) + CALL AD14_DestroyConstrState( AeroDyn14_DataData%z(i1), ErrStat, ErrMsg ) ENDDO -DO i1 = LBOUND(MoorDyn_DataData%OtherSt,1), UBOUND(MoorDyn_DataData%OtherSt,1) - CALL MD_DestroyOtherState( MoorDyn_DataData%OtherSt(i1), ErrStat, ErrMsg ) +DO i1 = LBOUND(AeroDyn14_DataData%OtherSt,1), UBOUND(AeroDyn14_DataData%OtherSt,1) + CALL AD14_DestroyOtherState( AeroDyn14_DataData%OtherSt(i1), ErrStat, ErrMsg ) ENDDO - CALL MD_DestroyParam( MoorDyn_DataData%p, ErrStat, ErrMsg ) - CALL MD_DestroyInput( MoorDyn_DataData%u, ErrStat, ErrMsg ) - CALL MD_DestroyOutput( MoorDyn_DataData%y, ErrStat, ErrMsg ) - CALL MD_DestroyMisc( MoorDyn_DataData%m, ErrStat, ErrMsg ) -IF (ALLOCATED(MoorDyn_DataData%Input)) THEN -DO i1 = LBOUND(MoorDyn_DataData%Input,1), UBOUND(MoorDyn_DataData%Input,1) - CALL MD_DestroyInput( MoorDyn_DataData%Input(i1), ErrStat, ErrMsg ) + CALL AD14_DestroyParam( AeroDyn14_DataData%p, ErrStat, ErrMsg ) + CALL AD14_DestroyInput( AeroDyn14_DataData%u, ErrStat, ErrMsg ) + CALL AD14_DestroyOutput( AeroDyn14_DataData%y, ErrStat, ErrMsg ) + CALL AD14_DestroyMisc( AeroDyn14_DataData%m, ErrStat, ErrMsg ) +IF (ALLOCATED(AeroDyn14_DataData%Input)) THEN +DO i1 = LBOUND(AeroDyn14_DataData%Input,1), UBOUND(AeroDyn14_DataData%Input,1) + CALL AD14_DestroyInput( AeroDyn14_DataData%Input(i1), ErrStat, ErrMsg ) ENDDO - DEALLOCATE(MoorDyn_DataData%Input) + DEALLOCATE(AeroDyn14_DataData%Input) ENDIF -IF (ALLOCATED(MoorDyn_DataData%InputTimes)) THEN - DEALLOCATE(MoorDyn_DataData%InputTimes) +IF (ALLOCATED(AeroDyn14_DataData%InputTimes)) THEN + DEALLOCATE(AeroDyn14_DataData%InputTimes) ENDIF - END SUBROUTINE FAST_DestroyMoorDyn_Data + END SUBROUTINE FAST_DestroyAeroDyn14_Data - SUBROUTINE FAST_PackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + SUBROUTINE FAST_PackAeroDyn14_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(MoorDyn_Data), INTENT(IN) :: InData + TYPE(AeroDyn14_Data), INTENT(IN) :: InData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly @@ -21336,7 +22048,7 @@ SUBROUTINE FAST_PackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackMoorDyn_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackAeroDyn14_Data' ! buffers to store subtypes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -21355,7 +22067,7 @@ SUBROUTINE FAST_PackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ! Allocate buffers for subtypes, if any (we'll get sizes from these) DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL MD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x + CALL AD14_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -21374,7 +22086,7 @@ SUBROUTINE FAST_PackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E END DO DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL MD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd + CALL AD14_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -21393,7 +22105,7 @@ SUBROUTINE FAST_PackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E END DO DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL MD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z + CALL AD14_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -21412,7 +22124,7 @@ SUBROUTINE FAST_PackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E END DO DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL MD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt + CALL AD14_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -21430,7 +22142,7 @@ SUBROUTINE FAST_PackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E END IF END DO Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL MD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p + CALL AD14_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -21447,7 +22159,7 @@ SUBROUTINE FAST_PackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL MD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u + CALL AD14_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -21464,7 +22176,7 @@ SUBROUTINE FAST_PackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL MD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y + CALL AD14_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -21481,7 +22193,7 @@ SUBROUTINE FAST_PackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL MD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m + CALL AD14_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -21502,7 +22214,7 @@ SUBROUTINE FAST_PackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL MD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input + CALL AD14_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -21553,7 +22265,7 @@ SUBROUTINE FAST_PackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_Xferred = 1 DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL MD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x + CALL AD14_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -21583,7 +22295,7 @@ SUBROUTINE FAST_PackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ENDIF END DO DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL MD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd + CALL AD14_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -21613,7 +22325,7 @@ SUBROUTINE FAST_PackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ENDIF END DO DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL MD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z + CALL AD14_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -21643,7 +22355,7 @@ SUBROUTINE FAST_PackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ENDIF END DO DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL MD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt + CALL AD14_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -21672,7 +22384,7 @@ SUBROUTINE FAST_PackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF END DO - CALL MD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p + CALL AD14_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -21700,7 +22412,7 @@ SUBROUTINE FAST_PackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL MD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u + CALL AD14_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -21728,7 +22440,7 @@ SUBROUTINE FAST_PackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL MD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y + CALL AD14_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -21756,7 +22468,7 @@ SUBROUTINE FAST_PackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL MD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m + CALL AD14_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -21795,7 +22507,7 @@ SUBROUTINE FAST_PackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL MD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input + CALL AD14_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -21835,16 +22547,18 @@ SUBROUTINE FAST_PackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, E IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%InputTimes)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%InputTimes))-1 ) = PACK(InData%InputTimes,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%InputTimes) + DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) + DbKiBuf(Db_Xferred) = InData%InputTimes(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF - END SUBROUTINE FAST_PackMoorDyn_Data + END SUBROUTINE FAST_PackAeroDyn14_Data - SUBROUTINE FAST_UnPackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + SUBROUTINE FAST_UnPackAeroDyn14_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(MoorDyn_Data), INTENT(INOUT) :: OutData + TYPE(AeroDyn14_Data), INTENT(INOUT) :: OutData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local variables @@ -21853,16 +22567,10 @@ SUBROUTINE FAST_UnPackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackMoorDyn_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackAeroDyn14_Data' ! buffers to store meshes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -21909,7 +22617,7 @@ SUBROUTINE FAST_UnPackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x + CALL AD14_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -21953,7 +22661,7 @@ SUBROUTINE FAST_UnPackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd + CALL AD14_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -21997,7 +22705,7 @@ SUBROUTINE FAST_UnPackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z + CALL AD14_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -22041,7 +22749,7 @@ SUBROUTINE FAST_UnPackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt + CALL AD14_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -22082,7 +22790,7 @@ SUBROUTINE FAST_UnPackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MD_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p + CALL AD14_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -22122,7 +22830,7 @@ SUBROUTINE FAST_UnPackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u + CALL AD14_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -22162,7 +22870,7 @@ SUBROUTINE FAST_UnPackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y + CALL AD14_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -22202,7 +22910,7 @@ SUBROUTINE FAST_UnPackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MD_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m + CALL AD14_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -22256,7 +22964,7 @@ SUBROUTINE FAST_UnPackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input + CALL AD14_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -22278,21 +22986,16 @@ SUBROUTINE FAST_UnPackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%InputTimes)>0) OutData%InputTimes = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%InputTimes))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%InputTimes) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) + OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO END IF - END SUBROUTINE FAST_UnPackMoorDyn_Data + END SUBROUTINE FAST_UnPackAeroDyn14_Data - SUBROUTINE FAST_CopyOrcaFlex_Data( SrcOrcaFlex_DataData, DstOrcaFlex_DataData, CtrlCode, ErrStat, ErrMsg ) - TYPE(OrcaFlex_Data), INTENT(INOUT) :: SrcOrcaFlex_DataData - TYPE(OrcaFlex_Data), INTENT(INOUT) :: DstOrcaFlex_DataData + SUBROUTINE FAST_CopyAeroDyn_Data( SrcAeroDyn_DataData, DstAeroDyn_DataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(AeroDyn_Data), INTENT(INOUT) :: SrcAeroDyn_DataData + TYPE(AeroDyn_Data), INTENT(INOUT) :: DstAeroDyn_DataData INTEGER(IntKi), INTENT(IN ) :: CtrlCode INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg @@ -22301,113 +23004,139 @@ SUBROUTINE FAST_CopyOrcaFlex_Data( SrcOrcaFlex_DataData, DstOrcaFlex_DataData, C INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyOrcaFlex_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyAeroDyn_Data' ! ErrStat = ErrID_None ErrMsg = "" - DO i1 = LBOUND(SrcOrcaFlex_DataData%x,1), UBOUND(SrcOrcaFlex_DataData%x,1) - CALL Orca_CopyContState( SrcOrcaFlex_DataData%x(i1), DstOrcaFlex_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcAeroDyn_DataData%x,1), UBOUND(SrcAeroDyn_DataData%x,1) + CALL AD_CopyContState( SrcAeroDyn_DataData%x(i1), DstAeroDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO - DO i1 = LBOUND(SrcOrcaFlex_DataData%xd,1), UBOUND(SrcOrcaFlex_DataData%xd,1) - CALL Orca_CopyDiscState( SrcOrcaFlex_DataData%xd(i1), DstOrcaFlex_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcAeroDyn_DataData%xd,1), UBOUND(SrcAeroDyn_DataData%xd,1) + CALL AD_CopyDiscState( SrcAeroDyn_DataData%xd(i1), DstAeroDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO - DO i1 = LBOUND(SrcOrcaFlex_DataData%z,1), UBOUND(SrcOrcaFlex_DataData%z,1) - CALL Orca_CopyConstrState( SrcOrcaFlex_DataData%z(i1), DstOrcaFlex_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcAeroDyn_DataData%z,1), UBOUND(SrcAeroDyn_DataData%z,1) + CALL AD_CopyConstrState( SrcAeroDyn_DataData%z(i1), DstAeroDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO - DO i1 = LBOUND(SrcOrcaFlex_DataData%OtherSt,1), UBOUND(SrcOrcaFlex_DataData%OtherSt,1) - CALL Orca_CopyOtherState( SrcOrcaFlex_DataData%OtherSt(i1), DstOrcaFlex_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcAeroDyn_DataData%OtherSt,1), UBOUND(SrcAeroDyn_DataData%OtherSt,1) + CALL AD_CopyOtherState( SrcAeroDyn_DataData%OtherSt(i1), DstAeroDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO - CALL Orca_CopyParam( SrcOrcaFlex_DataData%p, DstOrcaFlex_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) + CALL AD_CopyParam( SrcAeroDyn_DataData%p, DstAeroDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - CALL Orca_CopyInput( SrcOrcaFlex_DataData%u, DstOrcaFlex_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) + CALL AD_CopyInput( SrcAeroDyn_DataData%u, DstAeroDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - CALL Orca_CopyOutput( SrcOrcaFlex_DataData%y, DstOrcaFlex_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) + CALL AD_CopyOutput( SrcAeroDyn_DataData%y, DstAeroDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - CALL Orca_CopyMisc( SrcOrcaFlex_DataData%m, DstOrcaFlex_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) + CALL AD_CopyMisc( SrcAeroDyn_DataData%m, DstAeroDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcOrcaFlex_DataData%Input)) THEN - i1_l = LBOUND(SrcOrcaFlex_DataData%Input,1) - i1_u = UBOUND(SrcOrcaFlex_DataData%Input,1) - IF (.NOT. ALLOCATED(DstOrcaFlex_DataData%Input)) THEN - ALLOCATE(DstOrcaFlex_DataData%Input(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcAeroDyn_DataData%Output)) THEN + i1_l = LBOUND(SrcAeroDyn_DataData%Output,1) + i1_u = UBOUND(SrcAeroDyn_DataData%Output,1) + IF (.NOT. ALLOCATED(DstAeroDyn_DataData%Output)) THEN + ALLOCATE(DstAeroDyn_DataData%Output(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOrcaFlex_DataData%Input.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn_DataData%Output.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DO i1 = LBOUND(SrcOrcaFlex_DataData%Input,1), UBOUND(SrcOrcaFlex_DataData%Input,1) - CALL Orca_CopyInput( SrcOrcaFlex_DataData%Input(i1), DstOrcaFlex_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcAeroDyn_DataData%Output,1), UBOUND(SrcAeroDyn_DataData%Output,1) + CALL AD_CopyOutput( SrcAeroDyn_DataData%Output(i1), DstAeroDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO ENDIF -IF (ALLOCATED(SrcOrcaFlex_DataData%InputTimes)) THEN - i1_l = LBOUND(SrcOrcaFlex_DataData%InputTimes,1) - i1_u = UBOUND(SrcOrcaFlex_DataData%InputTimes,1) - IF (.NOT. ALLOCATED(DstOrcaFlex_DataData%InputTimes)) THEN - ALLOCATE(DstOrcaFlex_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) + CALL AD_CopyOutput( SrcAeroDyn_DataData%y_interp, DstAeroDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcAeroDyn_DataData%Input)) THEN + i1_l = LBOUND(SrcAeroDyn_DataData%Input,1) + i1_u = UBOUND(SrcAeroDyn_DataData%Input,1) + IF (.NOT. ALLOCATED(DstAeroDyn_DataData%Input)) THEN + ALLOCATE(DstAeroDyn_DataData%Input(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOrcaFlex_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DstOrcaFlex_DataData%InputTimes = SrcOrcaFlex_DataData%InputTimes + DO i1 = LBOUND(SrcAeroDyn_DataData%Input,1), UBOUND(SrcAeroDyn_DataData%Input,1) + CALL AD_CopyInput( SrcAeroDyn_DataData%Input(i1), DstAeroDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO ENDIF - END SUBROUTINE FAST_CopyOrcaFlex_Data +IF (ALLOCATED(SrcAeroDyn_DataData%InputTimes)) THEN + i1_l = LBOUND(SrcAeroDyn_DataData%InputTimes,1) + i1_u = UBOUND(SrcAeroDyn_DataData%InputTimes,1) + IF (.NOT. ALLOCATED(DstAeroDyn_DataData%InputTimes)) THEN + ALLOCATE(DstAeroDyn_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstAeroDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstAeroDyn_DataData%InputTimes = SrcAeroDyn_DataData%InputTimes +ENDIF + END SUBROUTINE FAST_CopyAeroDyn_Data - SUBROUTINE FAST_DestroyOrcaFlex_Data( OrcaFlex_DataData, ErrStat, ErrMsg ) - TYPE(OrcaFlex_Data), INTENT(INOUT) :: OrcaFlex_DataData + SUBROUTINE FAST_DestroyAeroDyn_Data( AeroDyn_DataData, ErrStat, ErrMsg ) + TYPE(AeroDyn_Data), INTENT(INOUT) :: AeroDyn_DataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyOrcaFlex_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyAeroDyn_Data' INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 ! ErrStat = ErrID_None ErrMsg = "" -DO i1 = LBOUND(OrcaFlex_DataData%x,1), UBOUND(OrcaFlex_DataData%x,1) - CALL Orca_DestroyContState( OrcaFlex_DataData%x(i1), ErrStat, ErrMsg ) +DO i1 = LBOUND(AeroDyn_DataData%x,1), UBOUND(AeroDyn_DataData%x,1) + CALL AD_DestroyContState( AeroDyn_DataData%x(i1), ErrStat, ErrMsg ) ENDDO -DO i1 = LBOUND(OrcaFlex_DataData%xd,1), UBOUND(OrcaFlex_DataData%xd,1) - CALL Orca_DestroyDiscState( OrcaFlex_DataData%xd(i1), ErrStat, ErrMsg ) +DO i1 = LBOUND(AeroDyn_DataData%xd,1), UBOUND(AeroDyn_DataData%xd,1) + CALL AD_DestroyDiscState( AeroDyn_DataData%xd(i1), ErrStat, ErrMsg ) ENDDO -DO i1 = LBOUND(OrcaFlex_DataData%z,1), UBOUND(OrcaFlex_DataData%z,1) - CALL Orca_DestroyConstrState( OrcaFlex_DataData%z(i1), ErrStat, ErrMsg ) +DO i1 = LBOUND(AeroDyn_DataData%z,1), UBOUND(AeroDyn_DataData%z,1) + CALL AD_DestroyConstrState( AeroDyn_DataData%z(i1), ErrStat, ErrMsg ) ENDDO -DO i1 = LBOUND(OrcaFlex_DataData%OtherSt,1), UBOUND(OrcaFlex_DataData%OtherSt,1) - CALL Orca_DestroyOtherState( OrcaFlex_DataData%OtherSt(i1), ErrStat, ErrMsg ) +DO i1 = LBOUND(AeroDyn_DataData%OtherSt,1), UBOUND(AeroDyn_DataData%OtherSt,1) + CALL AD_DestroyOtherState( AeroDyn_DataData%OtherSt(i1), ErrStat, ErrMsg ) ENDDO - CALL Orca_DestroyParam( OrcaFlex_DataData%p, ErrStat, ErrMsg ) - CALL Orca_DestroyInput( OrcaFlex_DataData%u, ErrStat, ErrMsg ) - CALL Orca_DestroyOutput( OrcaFlex_DataData%y, ErrStat, ErrMsg ) - CALL Orca_DestroyMisc( OrcaFlex_DataData%m, ErrStat, ErrMsg ) -IF (ALLOCATED(OrcaFlex_DataData%Input)) THEN -DO i1 = LBOUND(OrcaFlex_DataData%Input,1), UBOUND(OrcaFlex_DataData%Input,1) - CALL Orca_DestroyInput( OrcaFlex_DataData%Input(i1), ErrStat, ErrMsg ) + CALL AD_DestroyParam( AeroDyn_DataData%p, ErrStat, ErrMsg ) + CALL AD_DestroyInput( AeroDyn_DataData%u, ErrStat, ErrMsg ) + CALL AD_DestroyOutput( AeroDyn_DataData%y, ErrStat, ErrMsg ) + CALL AD_DestroyMisc( AeroDyn_DataData%m, ErrStat, ErrMsg ) +IF (ALLOCATED(AeroDyn_DataData%Output)) THEN +DO i1 = LBOUND(AeroDyn_DataData%Output,1), UBOUND(AeroDyn_DataData%Output,1) + CALL AD_DestroyOutput( AeroDyn_DataData%Output(i1), ErrStat, ErrMsg ) ENDDO - DEALLOCATE(OrcaFlex_DataData%Input) + DEALLOCATE(AeroDyn_DataData%Output) ENDIF -IF (ALLOCATED(OrcaFlex_DataData%InputTimes)) THEN - DEALLOCATE(OrcaFlex_DataData%InputTimes) + CALL AD_DestroyOutput( AeroDyn_DataData%y_interp, ErrStat, ErrMsg ) +IF (ALLOCATED(AeroDyn_DataData%Input)) THEN +DO i1 = LBOUND(AeroDyn_DataData%Input,1), UBOUND(AeroDyn_DataData%Input,1) + CALL AD_DestroyInput( AeroDyn_DataData%Input(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(AeroDyn_DataData%Input) ENDIF - END SUBROUTINE FAST_DestroyOrcaFlex_Data +IF (ALLOCATED(AeroDyn_DataData%InputTimes)) THEN + DEALLOCATE(AeroDyn_DataData%InputTimes) +ENDIF + END SUBROUTINE FAST_DestroyAeroDyn_Data - SUBROUTINE FAST_PackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + SUBROUTINE FAST_PackAeroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(OrcaFlex_Data), INTENT(IN) :: InData + TYPE(AeroDyn_Data), INTENT(IN) :: InData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly @@ -22422,7 +23151,7 @@ SUBROUTINE FAST_PackOrcaFlex_Data( 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 = 'FAST_PackOrcaFlex_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackAeroDyn_Data' ! buffers to store subtypes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -22441,7 +23170,7 @@ SUBROUTINE FAST_PackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ! Allocate buffers for subtypes, if any (we'll get sizes from these) DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype - CALL Orca_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x + CALL AD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -22460,7 +23189,7 @@ SUBROUTINE FAST_PackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, END DO DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype - CALL Orca_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd + CALL AD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -22479,7 +23208,7 @@ SUBROUTINE FAST_PackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, END DO DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype - CALL Orca_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z + CALL AD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -22498,7 +23227,7 @@ SUBROUTINE FAST_PackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, END DO DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype - CALL Orca_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt + CALL AD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -22516,7 +23245,7 @@ SUBROUTINE FAST_PackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, END IF END DO Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype - CALL Orca_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p + CALL AD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -22533,7 +23262,7 @@ SUBROUTINE FAST_PackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype - CALL Orca_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u + CALL AD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -22550,7 +23279,7 @@ SUBROUTINE FAST_PackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype - CALL Orca_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y + CALL AD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -22567,7 +23296,7 @@ SUBROUTINE FAST_PackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, DEALLOCATE(Int_Buf) END IF Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype - CALL Orca_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m + CALL AD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -22583,12 +23312,52 @@ SUBROUTINE FAST_PackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF + Int_BufSz = Int_BufSz + 1 ! Output allocated yes/no + IF ( ALLOCATED(InData%Output) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Output upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) + Int_BufSz = Int_BufSz + 3 ! Output: size of buffers for each call to pack subtype + CALL AD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Output + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Output + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Output + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Output + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 3 ! y_interp: size of buffers for each call to pack subtype + CALL AD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, .TRUE. ) ! y_interp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! y_interp + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! y_interp + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! y_interp + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no IF ( ALLOCATED(InData%Input) ) THEN Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype - CALL Orca_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input + CALL AD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -22639,7 +23408,7 @@ SUBROUTINE FAST_PackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_Xferred = 1 DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) - CALL Orca_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x + CALL AD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -22669,7 +23438,7 @@ SUBROUTINE FAST_PackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ENDIF END DO DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) - CALL Orca_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd + CALL AD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -22699,7 +23468,7 @@ SUBROUTINE FAST_PackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ENDIF END DO DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) - CALL Orca_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z + CALL AD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -22729,7 +23498,7 @@ SUBROUTINE FAST_PackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ENDIF END DO DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) - CALL Orca_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt + CALL AD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -22758,7 +23527,7 @@ SUBROUTINE FAST_PackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF END DO - CALL Orca_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p + CALL AD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -22786,7 +23555,7 @@ SUBROUTINE FAST_PackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL Orca_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u + CALL AD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -22814,7 +23583,7 @@ SUBROUTINE FAST_PackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL Orca_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y + CALL AD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -22842,7 +23611,76 @@ SUBROUTINE FAST_PackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL Orca_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m + CALL AD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%Output) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Output,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Output,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) + CALL AD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, OnlySize ) ! Output + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + CALL AD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, OnlySize ) ! y_interp CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -22881,7 +23719,7 @@ SUBROUTINE FAST_PackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_Xferred = Int_Xferred + 2 DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) - CALL Orca_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input + CALL AD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -22921,16 +23759,18 @@ SUBROUTINE FAST_PackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%InputTimes)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%InputTimes))-1 ) = PACK(InData%InputTimes,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%InputTimes) + DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) + DbKiBuf(Db_Xferred) = InData%InputTimes(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF - END SUBROUTINE FAST_PackOrcaFlex_Data + END SUBROUTINE FAST_PackAeroDyn_Data - SUBROUTINE FAST_UnPackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + SUBROUTINE FAST_UnPackAeroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(OrcaFlex_Data), INTENT(INOUT) :: OutData + TYPE(AeroDyn_Data), INTENT(INOUT) :: OutData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local variables @@ -22939,16 +23779,10 @@ SUBROUTINE FAST_UnPackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackOrcaFlex_Data' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackAeroDyn_Data' ! buffers to store meshes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -22995,7 +23829,7 @@ SUBROUTINE FAST_UnPackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL Orca_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x + CALL AD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -23039,7 +23873,7 @@ SUBROUTINE FAST_UnPackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL Orca_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd + CALL AD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -23083,7 +23917,7 @@ SUBROUTINE FAST_UnPackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL Orca_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z + CALL AD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -23127,7 +23961,7 @@ SUBROUTINE FAST_UnPackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL Orca_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt + CALL AD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -23168,7 +24002,7 @@ SUBROUTINE FAST_UnPackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL Orca_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p + CALL AD_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -23208,7 +24042,7 @@ SUBROUTINE FAST_UnPackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL Orca_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u + CALL AD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -23248,7 +24082,7 @@ SUBROUTINE FAST_UnPackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL Orca_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y + CALL AD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -23288,7 +24122,103 @@ SUBROUTINE FAST_UnPackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL Orca_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m + CALL AD_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Output not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Output)) DEALLOCATE(OutData%Output) + ALLOCATE(OutData%Output(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Output,1), UBOUND(OutData%Output,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL AD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%Output(i1), ErrStat2, ErrMsg2 ) ! Output + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL AD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_interp, ErrStat2, ErrMsg2 ) ! y_interp CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -23342,7 +24272,7 @@ SUBROUTINE FAST_UnPackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL Orca_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input + CALL AD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -23364,483 +24294,157 @@ SUBROUTINE FAST_UnPackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%InputTimes)>0) OutData%InputTimes = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%InputTimes))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%InputTimes) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) + OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO END IF - END SUBROUTINE FAST_UnPackOrcaFlex_Data + END SUBROUTINE FAST_UnPackAeroDyn_Data - SUBROUTINE FAST_CopyModuleMapType( SrcModuleMapTypeData, DstModuleMapTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_ModuleMapType), INTENT(INOUT) :: SrcModuleMapTypeData - TYPE(FAST_ModuleMapType), INTENT(INOUT) :: DstModuleMapTypeData + SUBROUTINE FAST_CopyInflowWind_Data( SrcInflowWind_DataData, DstInflowWind_DataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(InflowWind_Data), INTENT(IN) :: SrcInflowWind_DataData + TYPE(InflowWind_Data), INTENT(INOUT) :: DstInflowWind_DataData INTEGER(IntKi), INTENT(IN ) :: CtrlCode INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local INTEGER(IntKi) :: i,j,k INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyModuleMapType' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyInflowWind_Data' ! ErrStat = ErrID_None ErrMsg = "" -IF (ALLOCATED(SrcModuleMapTypeData%ED_P_2_BD_P)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%ED_P_2_BD_P,1) - i1_u = UBOUND(SrcModuleMapTypeData%ED_P_2_BD_P,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%ED_P_2_BD_P)) THEN - ALLOCATE(DstModuleMapTypeData%ED_P_2_BD_P(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%ED_P_2_BD_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%ED_P_2_BD_P,1), UBOUND(SrcModuleMapTypeData%ED_P_2_BD_P,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_BD_P(i1), DstModuleMapTypeData%ED_P_2_BD_P(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcInflowWind_DataData%x,1), UBOUND(SrcInflowWind_DataData%x,1) + CALL InflowWind_CopyContState( SrcInflowWind_DataData%x(i1), DstInflowWind_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%BD_P_2_ED_P)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%BD_P_2_ED_P,1) - i1_u = UBOUND(SrcModuleMapTypeData%BD_P_2_ED_P,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%BD_P_2_ED_P)) THEN - ALLOCATE(DstModuleMapTypeData%BD_P_2_ED_P(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BD_P_2_ED_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%BD_P_2_ED_P,1), UBOUND(SrcModuleMapTypeData%BD_P_2_ED_P,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%BD_P_2_ED_P(i1), DstModuleMapTypeData%BD_P_2_ED_P(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcInflowWind_DataData%xd,1), UBOUND(SrcInflowWind_DataData%xd,1) + CALL InflowWind_CopyDiscState( SrcInflowWind_DataData%xd(i1), DstInflowWind_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%ED_P_2_BD_P_Hub)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%ED_P_2_BD_P_Hub,1) - i1_u = UBOUND(SrcModuleMapTypeData%ED_P_2_BD_P_Hub,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%ED_P_2_BD_P_Hub)) THEN - ALLOCATE(DstModuleMapTypeData%ED_P_2_BD_P_Hub(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%ED_P_2_BD_P_Hub.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%ED_P_2_BD_P_Hub,1), UBOUND(SrcModuleMapTypeData%ED_P_2_BD_P_Hub,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_BD_P_Hub(i1), DstModuleMapTypeData%ED_P_2_BD_P_Hub(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcInflowWind_DataData%z,1), UBOUND(SrcInflowWind_DataData%z,1) + CALL InflowWind_CopyConstrState( SrcInflowWind_DataData%z(i1), DstInflowWind_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO -ENDIF - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_HD_W_P, DstModuleMapTypeData%ED_P_2_HD_W_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%HD_W_P_2_ED_P, DstModuleMapTypeData%HD_W_P_2_ED_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_HD_M_P, DstModuleMapTypeData%ED_P_2_HD_M_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%HD_M_P_2_ED_P, DstModuleMapTypeData%HD_M_P_2_ED_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_HD_M_L, DstModuleMapTypeData%ED_P_2_HD_M_L, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%HD_M_L_2_ED_P, DstModuleMapTypeData%HD_M_L_2_ED_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_Mooring_P, DstModuleMapTypeData%ED_P_2_Mooring_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%Mooring_P_2_ED_P, DstModuleMapTypeData%Mooring_P_2_ED_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_SD_TP, DstModuleMapTypeData%ED_P_2_SD_TP, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SD_TP_2_ED_P, DstModuleMapTypeData%SD_TP_2_ED_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SD_P_2_HD_M_P, DstModuleMapTypeData%SD_P_2_HD_M_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%HD_M_P_2_SD_P, DstModuleMapTypeData%HD_M_P_2_SD_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SD_P_2_HD_M_L, DstModuleMapTypeData%SD_P_2_HD_M_L, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%HD_M_L_2_SD_P, DstModuleMapTypeData%HD_M_L_2_SD_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_SrvD_P_N, DstModuleMapTypeData%ED_P_2_SrvD_P_N, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SrvD_P_2_ED_P_N, DstModuleMapTypeData%SrvD_P_2_ED_P_N, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_L_2_SrvD_P_T, DstModuleMapTypeData%ED_L_2_SrvD_P_T, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SrvD_P_2_ED_P_T, DstModuleMapTypeData%SrvD_P_2_ED_P_T, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcModuleMapTypeData%BDED_L_2_AD_L_B)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%BDED_L_2_AD_L_B,1) - i1_u = UBOUND(SrcModuleMapTypeData%BDED_L_2_AD_L_B,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%BDED_L_2_AD_L_B)) THEN - ALLOCATE(DstModuleMapTypeData%BDED_L_2_AD_L_B(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BDED_L_2_AD_L_B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%BDED_L_2_AD_L_B,1), UBOUND(SrcModuleMapTypeData%BDED_L_2_AD_L_B,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%BDED_L_2_AD_L_B(i1), DstModuleMapTypeData%BDED_L_2_AD_L_B(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcInflowWind_DataData%OtherSt,1), UBOUND(SrcInflowWind_DataData%OtherSt,1) + CALL InflowWind_CopyOtherState( SrcInflowWind_DataData%OtherSt(i1), DstInflowWind_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%AD_L_2_BDED_B)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%AD_L_2_BDED_B,1) - i1_u = UBOUND(SrcModuleMapTypeData%AD_L_2_BDED_B,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%AD_L_2_BDED_B)) THEN - ALLOCATE(DstModuleMapTypeData%AD_L_2_BDED_B(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%AD_L_2_BDED_B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%AD_L_2_BDED_B,1), UBOUND(SrcModuleMapTypeData%AD_L_2_BDED_B,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%AD_L_2_BDED_B(i1), DstModuleMapTypeData%AD_L_2_BDED_B(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL InflowWind_CopyParam( SrcInflowWind_DataData%p, DstInflowWind_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%BD_L_2_BD_L)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%BD_L_2_BD_L,1) - i1_u = UBOUND(SrcModuleMapTypeData%BD_L_2_BD_L,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%BD_L_2_BD_L)) THEN - ALLOCATE(DstModuleMapTypeData%BD_L_2_BD_L(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BD_L_2_BD_L.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%BD_L_2_BD_L,1), UBOUND(SrcModuleMapTypeData%BD_L_2_BD_L,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%BD_L_2_BD_L(i1), DstModuleMapTypeData%BD_L_2_BD_L(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL InflowWind_CopyInput( SrcInflowWind_DataData%u, DstInflowWind_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_L_2_AD_L_T, DstModuleMapTypeData%ED_L_2_AD_L_T, CtrlCode, ErrStat2, ErrMsg2 ) + CALL InflowWind_CopyOutput( SrcInflowWind_DataData%y, DstInflowWind_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%AD_L_2_ED_P_T, DstModuleMapTypeData%AD_L_2_ED_P_T, CtrlCode, ErrStat2, ErrMsg2 ) + CALL InflowWind_CopyMisc( SrcInflowWind_DataData%m, DstInflowWind_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcModuleMapTypeData%ED_P_2_AD_P_R)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%ED_P_2_AD_P_R,1) - i1_u = UBOUND(SrcModuleMapTypeData%ED_P_2_AD_P_R,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%ED_P_2_AD_P_R)) THEN - ALLOCATE(DstModuleMapTypeData%ED_P_2_AD_P_R(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcInflowWind_DataData%Output)) THEN + i1_l = LBOUND(SrcInflowWind_DataData%Output,1) + i1_u = UBOUND(SrcInflowWind_DataData%Output,1) + IF (.NOT. ALLOCATED(DstInflowWind_DataData%Output)) THEN + ALLOCATE(DstInflowWind_DataData%Output(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%ED_P_2_AD_P_R.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInflowWind_DataData%Output.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DO i1 = LBOUND(SrcModuleMapTypeData%ED_P_2_AD_P_R,1), UBOUND(SrcModuleMapTypeData%ED_P_2_AD_P_R,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_AD_P_R(i1), DstModuleMapTypeData%ED_P_2_AD_P_R(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcInflowWind_DataData%Output,1), UBOUND(SrcInflowWind_DataData%Output,1) + CALL InflowWind_CopyOutput( SrcInflowWind_DataData%Output(i1), DstInflowWind_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO ENDIF - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_AD_P_H, DstModuleMapTypeData%ED_P_2_AD_P_H, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%IceF_P_2_SD_P, DstModuleMapTypeData%IceF_P_2_SD_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SD_P_2_IceF_P, DstModuleMapTypeData%SD_P_2_IceF_P, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcModuleMapTypeData%IceD_P_2_SD_P)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%IceD_P_2_SD_P,1) - i1_u = UBOUND(SrcModuleMapTypeData%IceD_P_2_SD_P,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%IceD_P_2_SD_P)) THEN - ALLOCATE(DstModuleMapTypeData%IceD_P_2_SD_P(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%IceD_P_2_SD_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%IceD_P_2_SD_P,1), UBOUND(SrcModuleMapTypeData%IceD_P_2_SD_P,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%IceD_P_2_SD_P(i1), DstModuleMapTypeData%IceD_P_2_SD_P(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL InflowWind_CopyOutput( SrcInflowWind_DataData%y_interp, DstInflowWind_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%SD_P_2_IceD_P)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%SD_P_2_IceD_P,1) - i1_u = UBOUND(SrcModuleMapTypeData%SD_P_2_IceD_P,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%SD_P_2_IceD_P)) THEN - ALLOCATE(DstModuleMapTypeData%SD_P_2_IceD_P(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcInflowWind_DataData%Input)) THEN + i1_l = LBOUND(SrcInflowWind_DataData%Input,1) + i1_u = UBOUND(SrcInflowWind_DataData%Input,1) + IF (.NOT. ALLOCATED(DstInflowWind_DataData%Input)) THEN + ALLOCATE(DstInflowWind_DataData%Input(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%SD_P_2_IceD_P.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInflowWind_DataData%Input.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DO i1 = LBOUND(SrcModuleMapTypeData%SD_P_2_IceD_P,1), UBOUND(SrcModuleMapTypeData%SD_P_2_IceD_P,1) - CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SD_P_2_IceD_P(i1), DstModuleMapTypeData%SD_P_2_IceD_P(i1), CtrlCode, ErrStat2, ErrMsg2 ) + DO i1 = LBOUND(SrcInflowWind_DataData%Input,1), UBOUND(SrcInflowWind_DataData%Input,1) + CALL InflowWind_CopyInput( SrcInflowWind_DataData%Input(i1), DstInflowWind_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN ENDDO ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%Jacobian_Opt1)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%Jacobian_Opt1,1) - i1_u = UBOUND(SrcModuleMapTypeData%Jacobian_Opt1,1) - i2_l = LBOUND(SrcModuleMapTypeData%Jacobian_Opt1,2) - i2_u = UBOUND(SrcModuleMapTypeData%Jacobian_Opt1,2) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%Jacobian_Opt1)) THEN - ALLOCATE(DstModuleMapTypeData%Jacobian_Opt1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%Jacobian_Opt1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstModuleMapTypeData%Jacobian_Opt1 = SrcModuleMapTypeData%Jacobian_Opt1 -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%Jacobian_pivot)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%Jacobian_pivot,1) - i1_u = UBOUND(SrcModuleMapTypeData%Jacobian_pivot,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%Jacobian_pivot)) THEN - ALLOCATE(DstModuleMapTypeData%Jacobian_pivot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%Jacobian_pivot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstModuleMapTypeData%Jacobian_pivot = SrcModuleMapTypeData%Jacobian_pivot -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%Jac_u_indx)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%Jac_u_indx,1) - i1_u = UBOUND(SrcModuleMapTypeData%Jac_u_indx,1) - i2_l = LBOUND(SrcModuleMapTypeData%Jac_u_indx,2) - i2_u = UBOUND(SrcModuleMapTypeData%Jac_u_indx,2) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%Jac_u_indx)) THEN - ALLOCATE(DstModuleMapTypeData%Jac_u_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstModuleMapTypeData%Jac_u_indx = SrcModuleMapTypeData%Jac_u_indx -ENDIF - CALL MeshCopy( SrcModuleMapTypeData%u_ED_PlatformPtMesh, DstModuleMapTypeData%u_ED_PlatformPtMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcModuleMapTypeData%u_ED_PlatformPtMesh_2, DstModuleMapTypeData%u_ED_PlatformPtMesh_2, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcModuleMapTypeData%u_SD_TPMesh, DstModuleMapTypeData%u_SD_TPMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcModuleMapTypeData%u_SD_LMesh, DstModuleMapTypeData%u_SD_LMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcModuleMapTypeData%u_SD_LMesh_2, DstModuleMapTypeData%u_SD_LMesh_2, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcModuleMapTypeData%u_HD_M_LumpedMesh, DstModuleMapTypeData%u_HD_M_LumpedMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcModuleMapTypeData%u_HD_M_DistribMesh, DstModuleMapTypeData%u_HD_M_DistribMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcModuleMapTypeData%u_HD_Mesh, DstModuleMapTypeData%u_HD_Mesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcModuleMapTypeData%u_ED_HubPtLoad, DstModuleMapTypeData%u_ED_HubPtLoad, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcModuleMapTypeData%u_ED_HubPtLoad_2, DstModuleMapTypeData%u_ED_HubPtLoad_2, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN -IF (ALLOCATED(SrcModuleMapTypeData%u_BD_RootMotion)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%u_BD_RootMotion,1) - i1_u = UBOUND(SrcModuleMapTypeData%u_BD_RootMotion,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%u_BD_RootMotion)) THEN - ALLOCATE(DstModuleMapTypeData%u_BD_RootMotion(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%u_BD_RootMotion.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DO i1 = LBOUND(SrcModuleMapTypeData%u_BD_RootMotion,1), UBOUND(SrcModuleMapTypeData%u_BD_RootMotion,1) - CALL MeshCopy( SrcModuleMapTypeData%u_BD_RootMotion(i1), DstModuleMapTypeData%u_BD_RootMotion(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO -ENDIF -IF (ALLOCATED(SrcModuleMapTypeData%y_BD_BldMotion_4Loads)) THEN - i1_l = LBOUND(SrcModuleMapTypeData%y_BD_BldMotion_4Loads,1) - i1_u = UBOUND(SrcModuleMapTypeData%y_BD_BldMotion_4Loads,1) - IF (.NOT. ALLOCATED(DstModuleMapTypeData%y_BD_BldMotion_4Loads)) THEN - ALLOCATE(DstModuleMapTypeData%y_BD_BldMotion_4Loads(i1_l:i1_u),STAT=ErrStat2) +IF (ALLOCATED(SrcInflowWind_DataData%InputTimes)) THEN + i1_l = LBOUND(SrcInflowWind_DataData%InputTimes,1) + i1_u = UBOUND(SrcInflowWind_DataData%InputTimes,1) + IF (.NOT. ALLOCATED(DstInflowWind_DataData%InputTimes)) THEN + ALLOCATE(DstInflowWind_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%y_BD_BldMotion_4Loads.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInflowWind_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) RETURN END IF END IF - DO i1 = LBOUND(SrcModuleMapTypeData%y_BD_BldMotion_4Loads,1), UBOUND(SrcModuleMapTypeData%y_BD_BldMotion_4Loads,1) - CALL MeshCopy( SrcModuleMapTypeData%y_BD_BldMotion_4Loads(i1), DstModuleMapTypeData%y_BD_BldMotion_4Loads(i1), CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - ENDDO + DstInflowWind_DataData%InputTimes = SrcInflowWind_DataData%InputTimes ENDIF - CALL MeshCopy( SrcModuleMapTypeData%u_Orca_PtfmMesh, DstModuleMapTypeData%u_Orca_PtfmMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - CALL MeshCopy( SrcModuleMapTypeData%u_ExtPtfm_PtfmMesh, DstModuleMapTypeData%u_ExtPtfm_PtfmMesh, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - END SUBROUTINE FAST_CopyModuleMapType + END SUBROUTINE FAST_CopyInflowWind_Data - SUBROUTINE FAST_DestroyModuleMapType( ModuleMapTypeData, ErrStat, ErrMsg ) - TYPE(FAST_ModuleMapType), INTENT(INOUT) :: ModuleMapTypeData + SUBROUTINE FAST_DestroyInflowWind_Data( InflowWind_DataData, ErrStat, ErrMsg ) + TYPE(InflowWind_Data), INTENT(INOUT) :: InflowWind_DataData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyModuleMapType' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyInflowWind_Data' INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 ! ErrStat = ErrID_None ErrMsg = "" -IF (ALLOCATED(ModuleMapTypeData%ED_P_2_BD_P)) THEN -DO i1 = LBOUND(ModuleMapTypeData%ED_P_2_BD_P,1), UBOUND(ModuleMapTypeData%ED_P_2_BD_P,1) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ED_P_2_BD_P(i1), ErrStat, ErrMsg ) +DO i1 = LBOUND(InflowWind_DataData%x,1), UBOUND(InflowWind_DataData%x,1) + CALL InflowWind_DestroyContState( InflowWind_DataData%x(i1), ErrStat, ErrMsg ) ENDDO - DEALLOCATE(ModuleMapTypeData%ED_P_2_BD_P) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%BD_P_2_ED_P)) THEN -DO i1 = LBOUND(ModuleMapTypeData%BD_P_2_ED_P,1), UBOUND(ModuleMapTypeData%BD_P_2_ED_P,1) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%BD_P_2_ED_P(i1), ErrStat, ErrMsg ) +DO i1 = LBOUND(InflowWind_DataData%xd,1), UBOUND(InflowWind_DataData%xd,1) + CALL InflowWind_DestroyDiscState( InflowWind_DataData%xd(i1), ErrStat, ErrMsg ) ENDDO - DEALLOCATE(ModuleMapTypeData%BD_P_2_ED_P) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%ED_P_2_BD_P_Hub)) THEN -DO i1 = LBOUND(ModuleMapTypeData%ED_P_2_BD_P_Hub,1), UBOUND(ModuleMapTypeData%ED_P_2_BD_P_Hub,1) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ED_P_2_BD_P_Hub(i1), ErrStat, ErrMsg ) +DO i1 = LBOUND(InflowWind_DataData%z,1), UBOUND(InflowWind_DataData%z,1) + CALL InflowWind_DestroyConstrState( InflowWind_DataData%z(i1), ErrStat, ErrMsg ) ENDDO - DEALLOCATE(ModuleMapTypeData%ED_P_2_BD_P_Hub) -ENDIF - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ED_P_2_HD_W_P, ErrStat, ErrMsg ) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%HD_W_P_2_ED_P, ErrStat, ErrMsg ) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ED_P_2_HD_M_P, ErrStat, ErrMsg ) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%HD_M_P_2_ED_P, ErrStat, ErrMsg ) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ED_P_2_HD_M_L, ErrStat, ErrMsg ) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%HD_M_L_2_ED_P, ErrStat, ErrMsg ) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ED_P_2_Mooring_P, ErrStat, ErrMsg ) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%Mooring_P_2_ED_P, ErrStat, ErrMsg ) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ED_P_2_SD_TP, ErrStat, ErrMsg ) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%SD_TP_2_ED_P, ErrStat, ErrMsg ) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%SD_P_2_HD_M_P, ErrStat, ErrMsg ) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%HD_M_P_2_SD_P, ErrStat, ErrMsg ) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%SD_P_2_HD_M_L, ErrStat, ErrMsg ) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%HD_M_L_2_SD_P, ErrStat, ErrMsg ) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ED_P_2_SrvD_P_N, ErrStat, ErrMsg ) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%SrvD_P_2_ED_P_N, ErrStat, ErrMsg ) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ED_L_2_SrvD_P_T, ErrStat, ErrMsg ) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%SrvD_P_2_ED_P_T, ErrStat, ErrMsg ) -IF (ALLOCATED(ModuleMapTypeData%BDED_L_2_AD_L_B)) THEN -DO i1 = LBOUND(ModuleMapTypeData%BDED_L_2_AD_L_B,1), UBOUND(ModuleMapTypeData%BDED_L_2_AD_L_B,1) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%BDED_L_2_AD_L_B(i1), ErrStat, ErrMsg ) +DO i1 = LBOUND(InflowWind_DataData%OtherSt,1), UBOUND(InflowWind_DataData%OtherSt,1) + CALL InflowWind_DestroyOtherState( InflowWind_DataData%OtherSt(i1), ErrStat, ErrMsg ) ENDDO - DEALLOCATE(ModuleMapTypeData%BDED_L_2_AD_L_B) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%AD_L_2_BDED_B)) THEN -DO i1 = LBOUND(ModuleMapTypeData%AD_L_2_BDED_B,1), UBOUND(ModuleMapTypeData%AD_L_2_BDED_B,1) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%AD_L_2_BDED_B(i1), ErrStat, ErrMsg ) + CALL InflowWind_DestroyParam( InflowWind_DataData%p, ErrStat, ErrMsg ) + CALL InflowWind_DestroyInput( InflowWind_DataData%u, ErrStat, ErrMsg ) + CALL InflowWind_DestroyOutput( InflowWind_DataData%y, ErrStat, ErrMsg ) + CALL InflowWind_DestroyMisc( InflowWind_DataData%m, ErrStat, ErrMsg ) +IF (ALLOCATED(InflowWind_DataData%Output)) THEN +DO i1 = LBOUND(InflowWind_DataData%Output,1), UBOUND(InflowWind_DataData%Output,1) + CALL InflowWind_DestroyOutput( InflowWind_DataData%Output(i1), ErrStat, ErrMsg ) ENDDO - DEALLOCATE(ModuleMapTypeData%AD_L_2_BDED_B) + DEALLOCATE(InflowWind_DataData%Output) ENDIF -IF (ALLOCATED(ModuleMapTypeData%BD_L_2_BD_L)) THEN -DO i1 = LBOUND(ModuleMapTypeData%BD_L_2_BD_L,1), UBOUND(ModuleMapTypeData%BD_L_2_BD_L,1) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%BD_L_2_BD_L(i1), ErrStat, ErrMsg ) + CALL InflowWind_DestroyOutput( InflowWind_DataData%y_interp, ErrStat, ErrMsg ) +IF (ALLOCATED(InflowWind_DataData%Input)) THEN +DO i1 = LBOUND(InflowWind_DataData%Input,1), UBOUND(InflowWind_DataData%Input,1) + CALL InflowWind_DestroyInput( InflowWind_DataData%Input(i1), ErrStat, ErrMsg ) ENDDO - DEALLOCATE(ModuleMapTypeData%BD_L_2_BD_L) + DEALLOCATE(InflowWind_DataData%Input) ENDIF - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ED_L_2_AD_L_T, ErrStat, ErrMsg ) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%AD_L_2_ED_P_T, ErrStat, ErrMsg ) -IF (ALLOCATED(ModuleMapTypeData%ED_P_2_AD_P_R)) THEN -DO i1 = LBOUND(ModuleMapTypeData%ED_P_2_AD_P_R,1), UBOUND(ModuleMapTypeData%ED_P_2_AD_P_R,1) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ED_P_2_AD_P_R(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(ModuleMapTypeData%ED_P_2_AD_P_R) -ENDIF - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ED_P_2_AD_P_H, ErrStat, ErrMsg ) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%IceF_P_2_SD_P, ErrStat, ErrMsg ) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%SD_P_2_IceF_P, ErrStat, ErrMsg ) -IF (ALLOCATED(ModuleMapTypeData%IceD_P_2_SD_P)) THEN -DO i1 = LBOUND(ModuleMapTypeData%IceD_P_2_SD_P,1), UBOUND(ModuleMapTypeData%IceD_P_2_SD_P,1) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%IceD_P_2_SD_P(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(ModuleMapTypeData%IceD_P_2_SD_P) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%SD_P_2_IceD_P)) THEN -DO i1 = LBOUND(ModuleMapTypeData%SD_P_2_IceD_P,1), UBOUND(ModuleMapTypeData%SD_P_2_IceD_P,1) - CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%SD_P_2_IceD_P(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(ModuleMapTypeData%SD_P_2_IceD_P) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%Jacobian_Opt1)) THEN - DEALLOCATE(ModuleMapTypeData%Jacobian_Opt1) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%Jacobian_pivot)) THEN - DEALLOCATE(ModuleMapTypeData%Jacobian_pivot) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%Jac_u_indx)) THEN - DEALLOCATE(ModuleMapTypeData%Jac_u_indx) -ENDIF - CALL MeshDestroy( ModuleMapTypeData%u_ED_PlatformPtMesh, ErrStat, ErrMsg ) - CALL MeshDestroy( ModuleMapTypeData%u_ED_PlatformPtMesh_2, ErrStat, ErrMsg ) - CALL MeshDestroy( ModuleMapTypeData%u_SD_TPMesh, ErrStat, ErrMsg ) - CALL MeshDestroy( ModuleMapTypeData%u_SD_LMesh, ErrStat, ErrMsg ) - CALL MeshDestroy( ModuleMapTypeData%u_SD_LMesh_2, ErrStat, ErrMsg ) - CALL MeshDestroy( ModuleMapTypeData%u_HD_M_LumpedMesh, ErrStat, ErrMsg ) - CALL MeshDestroy( ModuleMapTypeData%u_HD_M_DistribMesh, ErrStat, ErrMsg ) - CALL MeshDestroy( ModuleMapTypeData%u_HD_Mesh, ErrStat, ErrMsg ) - CALL MeshDestroy( ModuleMapTypeData%u_ED_HubPtLoad, ErrStat, ErrMsg ) - CALL MeshDestroy( ModuleMapTypeData%u_ED_HubPtLoad_2, ErrStat, ErrMsg ) -IF (ALLOCATED(ModuleMapTypeData%u_BD_RootMotion)) THEN -DO i1 = LBOUND(ModuleMapTypeData%u_BD_RootMotion,1), UBOUND(ModuleMapTypeData%u_BD_RootMotion,1) - CALL MeshDestroy( ModuleMapTypeData%u_BD_RootMotion(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(ModuleMapTypeData%u_BD_RootMotion) -ENDIF -IF (ALLOCATED(ModuleMapTypeData%y_BD_BldMotion_4Loads)) THEN -DO i1 = LBOUND(ModuleMapTypeData%y_BD_BldMotion_4Loads,1), UBOUND(ModuleMapTypeData%y_BD_BldMotion_4Loads,1) - CALL MeshDestroy( ModuleMapTypeData%y_BD_BldMotion_4Loads(i1), ErrStat, ErrMsg ) -ENDDO - DEALLOCATE(ModuleMapTypeData%y_BD_BldMotion_4Loads) +IF (ALLOCATED(InflowWind_DataData%InputTimes)) THEN + DEALLOCATE(InflowWind_DataData%InputTimes) ENDIF - CALL MeshDestroy( ModuleMapTypeData%u_Orca_PtfmMesh, ErrStat, ErrMsg ) - CALL MeshDestroy( ModuleMapTypeData%u_ExtPtfm_PtfmMesh, ErrStat, ErrMsg ) - END SUBROUTINE FAST_DestroyModuleMapType + END SUBROUTINE FAST_DestroyInflowWind_Data - SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + SUBROUTINE FAST_PackInflowWind_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FAST_ModuleMapType), INTENT(IN) :: InData + TYPE(InflowWind_Data), INTENT(IN) :: InData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly @@ -23855,7 +24459,7 @@ SUBROUTINE FAST_PackModuleMapType( 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 = 'FAST_PackModuleMapType' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackInflowWind_Data' ! buffers to store subtypes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -23871,1441 +24475,17058 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Re_BufSz = 0 Db_BufSz = 0 Int_BufSz = 0 - Int_BufSz = Int_BufSz + 1 ! ED_P_2_BD_P allocated yes/no - IF ( ALLOCATED(InData%ED_P_2_BD_P) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ED_P_2_BD_P upper/lower bounds for each dimension ! Allocate buffers for subtypes, if any (we'll get sizes from these) - DO i1 = LBOUND(InData%ED_P_2_BD_P,1), UBOUND(InData%ED_P_2_BD_P,1) - Int_BufSz = Int_BufSz + 3 ! ED_P_2_BD_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_BD_P(i1), ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_BD_P + DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) + Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype + CALL InflowWind_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! x + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! x + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! x + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) + Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype + CALL InflowWind_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! xd + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! xd + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! xd + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) + Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype + CALL InflowWind_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! z + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! z + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! z + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) + Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype + CALL InflowWind_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! OtherSt + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OtherSt + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OtherSt + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype + CALL InflowWind_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! p + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! p + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! p + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype + CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype + CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! y + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! y + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! y + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype + CALL InflowWind_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! m + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! m + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! m + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! Output allocated yes/no + IF ( ALLOCATED(InData%Output) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Output upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) + Int_BufSz = Int_BufSz + 3 ! Output: size of buffers for each call to pack subtype + CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Output + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Output + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Output + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Output + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 3 ! y_interp: size of buffers for each call to pack subtype + CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, .TRUE. ) ! y_interp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! y_interp + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! y_interp + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! y_interp + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no + IF ( ALLOCATED(InData%Input) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) + Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype + CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Input + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Input + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Input + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no + IF ( ALLOCATED(InData%InputTimes) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) + CALL InflowWind_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) + CALL InflowWind_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) + CALL InflowWind_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) + CALL InflowWind_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + CALL InflowWind_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL InflowWind_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%Output) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Output,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Output,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) + CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, OnlySize ) ! Output + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + CALL InflowWind_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, OnlySize ) ! y_interp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%Input) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) + CALL InflowWind_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%InputTimes) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) + DbKiBuf(Db_Xferred) = InData%InputTimes(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + END SUBROUTINE FAST_PackInflowWind_Data + + SUBROUTINE FAST_UnPackInflowWind_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(InflowWind_Data), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackInflowWind_Data' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + i1_l = LBOUND(OutData%x,1) + i1_u = UBOUND(OutData%x,1) + DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL InflowWind_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + i1_l = LBOUND(OutData%xd,1) + i1_u = UBOUND(OutData%xd,1) + DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL InflowWind_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + i1_l = LBOUND(OutData%z,1) + i1_u = UBOUND(OutData%z,1) + DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL InflowWind_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + i1_l = LBOUND(OutData%OtherSt,1) + i1_u = UBOUND(OutData%OtherSt,1) + DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL InflowWind_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL InflowWind_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL InflowWind_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL InflowWind_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL InflowWind_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Output not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Output)) DEALLOCATE(OutData%Output) + ALLOCATE(OutData%Output(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Output,1), UBOUND(OutData%Output,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL InflowWind_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%Output(i1), ErrStat2, ErrMsg2 ) ! Output + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL InflowWind_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_interp, ErrStat2, ErrMsg2 ) ! y_interp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Input)) DEALLOCATE(OutData%Input) + ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL InflowWind_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%InputTimes)) DEALLOCATE(OutData%InputTimes) + ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) + OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + END SUBROUTINE FAST_UnPackInflowWind_Data + + SUBROUTINE FAST_CopyOpenFOAM_Data( SrcOpenFOAM_DataData, DstOpenFOAM_DataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(OpenFOAM_Data), INTENT(INOUT) :: SrcOpenFOAM_DataData + TYPE(OpenFOAM_Data), INTENT(INOUT) :: DstOpenFOAM_DataData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyOpenFOAM_Data' +! + ErrStat = ErrID_None + ErrMsg = "" + CALL OpFM_CopyInput( SrcOpenFOAM_DataData%u, DstOpenFOAM_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL OpFM_CopyOutput( SrcOpenFOAM_DataData%y, DstOpenFOAM_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL OpFM_CopyParam( SrcOpenFOAM_DataData%p, DstOpenFOAM_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL OpFM_CopyMisc( SrcOpenFOAM_DataData%m, DstOpenFOAM_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + END SUBROUTINE FAST_CopyOpenFOAM_Data + + SUBROUTINE FAST_DestroyOpenFOAM_Data( OpenFOAM_DataData, ErrStat, ErrMsg ) + TYPE(OpenFOAM_Data), INTENT(INOUT) :: OpenFOAM_DataData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyOpenFOAM_Data' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" + CALL OpFM_DestroyInput( OpenFOAM_DataData%u, ErrStat, ErrMsg ) + CALL OpFM_DestroyOutput( OpenFOAM_DataData%y, ErrStat, ErrMsg ) + CALL OpFM_DestroyParam( OpenFOAM_DataData%p, ErrStat, ErrMsg ) + CALL OpFM_DestroyMisc( OpenFOAM_DataData%m, ErrStat, ErrMsg ) + END SUBROUTINE FAST_DestroyOpenFOAM_Data + + SUBROUTINE FAST_PackOpenFOAM_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(OpenFOAM_Data), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackOpenFOAM_Data' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype + CALL OpFM_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype + CALL OpFM_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! y + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! y + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! y + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype + CALL OpFM_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! p + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! p + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! p + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype + CALL OpFM_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! m + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! m + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! m + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + CALL OpFM_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL OpFM_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL OpFM_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL OpFM_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END SUBROUTINE FAST_PackOpenFOAM_Data + + SUBROUTINE FAST_UnPackOpenFOAM_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(OpenFOAM_Data), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackOpenFOAM_Data' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL OpFM_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL OpFM_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL OpFM_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL OpFM_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END SUBROUTINE FAST_UnPackOpenFOAM_Data + + SUBROUTINE FAST_CopySuperController_Data( SrcSuperController_DataData, DstSuperController_DataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(SuperController_Data), INTENT(IN) :: SrcSuperController_DataData + TYPE(SuperController_Data), INTENT(INOUT) :: DstSuperController_DataData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopySuperController_Data' +! + ErrStat = ErrID_None + ErrMsg = "" + CALL SC_CopyInput( SrcSuperController_DataData%u, DstSuperController_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL SC_CopyOutput( SrcSuperController_DataData%y, DstSuperController_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL SC_CopyParam( SrcSuperController_DataData%p, DstSuperController_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + END SUBROUTINE FAST_CopySuperController_Data + + SUBROUTINE FAST_DestroySuperController_Data( SuperController_DataData, ErrStat, ErrMsg ) + TYPE(SuperController_Data), INTENT(INOUT) :: SuperController_DataData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroySuperController_Data' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" + CALL SC_DestroyInput( SuperController_DataData%u, ErrStat, ErrMsg ) + CALL SC_DestroyOutput( SuperController_DataData%y, ErrStat, ErrMsg ) + CALL SC_DestroyParam( SuperController_DataData%p, ErrStat, ErrMsg ) + END SUBROUTINE FAST_DestroySuperController_Data + + SUBROUTINE FAST_PackSuperController_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(SuperController_Data), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackSuperController_Data' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype + CALL SC_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype + CALL SC_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! y + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! y + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! y + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype + CALL SC_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! p + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! p + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! p + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + CALL SC_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL SC_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL SC_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END SUBROUTINE FAST_PackSuperController_Data + + SUBROUTINE FAST_UnPackSuperController_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(SuperController_Data), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackSuperController_Data' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SC_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SC_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SC_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END SUBROUTINE FAST_UnPackSuperController_Data + + SUBROUTINE FAST_CopySubDyn_Data( SrcSubDyn_DataData, DstSubDyn_DataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(SubDyn_Data), INTENT(INOUT) :: SrcSubDyn_DataData + TYPE(SubDyn_Data), INTENT(INOUT) :: DstSubDyn_DataData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopySubDyn_Data' +! + ErrStat = ErrID_None + ErrMsg = "" + DO i1 = LBOUND(SrcSubDyn_DataData%x,1), UBOUND(SrcSubDyn_DataData%x,1) + CALL SD_CopyContState( SrcSubDyn_DataData%x(i1), DstSubDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcSubDyn_DataData%xd,1), UBOUND(SrcSubDyn_DataData%xd,1) + CALL SD_CopyDiscState( SrcSubDyn_DataData%xd(i1), DstSubDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcSubDyn_DataData%z,1), UBOUND(SrcSubDyn_DataData%z,1) + CALL SD_CopyConstrState( SrcSubDyn_DataData%z(i1), DstSubDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcSubDyn_DataData%OtherSt,1), UBOUND(SrcSubDyn_DataData%OtherSt,1) + CALL SD_CopyOtherState( SrcSubDyn_DataData%OtherSt(i1), DstSubDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + CALL SD_CopyParam( SrcSubDyn_DataData%p, DstSubDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL SD_CopyInput( SrcSubDyn_DataData%u, DstSubDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL SD_CopyOutput( SrcSubDyn_DataData%y, DstSubDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL SD_CopyMisc( SrcSubDyn_DataData%m, DstSubDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcSubDyn_DataData%Input)) THEN + i1_l = LBOUND(SrcSubDyn_DataData%Input,1) + i1_u = UBOUND(SrcSubDyn_DataData%Input,1) + IF (.NOT. ALLOCATED(DstSubDyn_DataData%Input)) THEN + ALLOCATE(DstSubDyn_DataData%Input(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSubDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcSubDyn_DataData%Input,1), UBOUND(SrcSubDyn_DataData%Input,1) + CALL SD_CopyInput( SrcSubDyn_DataData%Input(i1), DstSubDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcSubDyn_DataData%InputTimes)) THEN + i1_l = LBOUND(SrcSubDyn_DataData%InputTimes,1) + i1_u = UBOUND(SrcSubDyn_DataData%InputTimes,1) + IF (.NOT. ALLOCATED(DstSubDyn_DataData%InputTimes)) THEN + ALLOCATE(DstSubDyn_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstSubDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstSubDyn_DataData%InputTimes = SrcSubDyn_DataData%InputTimes +ENDIF + END SUBROUTINE FAST_CopySubDyn_Data + + SUBROUTINE FAST_DestroySubDyn_Data( SubDyn_DataData, ErrStat, ErrMsg ) + TYPE(SubDyn_Data), INTENT(INOUT) :: SubDyn_DataData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroySubDyn_Data' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +DO i1 = LBOUND(SubDyn_DataData%x,1), UBOUND(SubDyn_DataData%x,1) + CALL SD_DestroyContState( SubDyn_DataData%x(i1), ErrStat, ErrMsg ) +ENDDO +DO i1 = LBOUND(SubDyn_DataData%xd,1), UBOUND(SubDyn_DataData%xd,1) + CALL SD_DestroyDiscState( SubDyn_DataData%xd(i1), ErrStat, ErrMsg ) +ENDDO +DO i1 = LBOUND(SubDyn_DataData%z,1), UBOUND(SubDyn_DataData%z,1) + CALL SD_DestroyConstrState( SubDyn_DataData%z(i1), ErrStat, ErrMsg ) +ENDDO +DO i1 = LBOUND(SubDyn_DataData%OtherSt,1), UBOUND(SubDyn_DataData%OtherSt,1) + CALL SD_DestroyOtherState( SubDyn_DataData%OtherSt(i1), ErrStat, ErrMsg ) +ENDDO + CALL SD_DestroyParam( SubDyn_DataData%p, ErrStat, ErrMsg ) + CALL SD_DestroyInput( SubDyn_DataData%u, ErrStat, ErrMsg ) + CALL SD_DestroyOutput( SubDyn_DataData%y, ErrStat, ErrMsg ) + CALL SD_DestroyMisc( SubDyn_DataData%m, ErrStat, ErrMsg ) +IF (ALLOCATED(SubDyn_DataData%Input)) THEN +DO i1 = LBOUND(SubDyn_DataData%Input,1), UBOUND(SubDyn_DataData%Input,1) + CALL SD_DestroyInput( SubDyn_DataData%Input(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(SubDyn_DataData%Input) +ENDIF +IF (ALLOCATED(SubDyn_DataData%InputTimes)) THEN + DEALLOCATE(SubDyn_DataData%InputTimes) +ENDIF + END SUBROUTINE FAST_DestroySubDyn_Data + + SUBROUTINE FAST_PackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(SubDyn_Data), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackSubDyn_Data' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) + Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype + CALL SD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! x + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! x + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! x + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) + Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype + CALL SD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! xd + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! xd + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! xd + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) + Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype + CALL SD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! z + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! z + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! z + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) + Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype + CALL SD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! OtherSt + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OtherSt + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OtherSt + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype + CALL SD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! p + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! p + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! p + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype + CALL SD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype + CALL SD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! y + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! y + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! y + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype + CALL SD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! m + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! m + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! m + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no + IF ( ALLOCATED(InData%Input) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) + Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype + CALL SD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Input + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Input + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Input + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no + IF ( ALLOCATED(InData%InputTimes) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) + CALL SD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) + CALL SD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) + CALL SD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) + CALL SD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + CALL SD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL SD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL SD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL SD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%Input) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) + CALL SD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%InputTimes) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) + DbKiBuf(Db_Xferred) = InData%InputTimes(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + END SUBROUTINE FAST_PackSubDyn_Data + + SUBROUTINE FAST_UnPackSubDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(SubDyn_Data), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackSubDyn_Data' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + i1_l = LBOUND(OutData%x,1) + i1_u = UBOUND(OutData%x,1) + DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + i1_l = LBOUND(OutData%xd,1) + i1_u = UBOUND(OutData%xd,1) + DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + i1_l = LBOUND(OutData%z,1) + i1_u = UBOUND(OutData%z,1) + DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + i1_l = LBOUND(OutData%OtherSt,1) + i1_u = UBOUND(OutData%OtherSt,1) + DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SD_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SD_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Input)) DEALLOCATE(OutData%Input) + ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL SD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%InputTimes)) DEALLOCATE(OutData%InputTimes) + ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) + OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + END SUBROUTINE FAST_UnPackSubDyn_Data + + SUBROUTINE FAST_CopyExtPtfm_Data( SrcExtPtfm_DataData, DstExtPtfm_DataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(ExtPtfm_Data), INTENT(INOUT) :: SrcExtPtfm_DataData + TYPE(ExtPtfm_Data), INTENT(INOUT) :: DstExtPtfm_DataData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyExtPtfm_Data' +! + ErrStat = ErrID_None + ErrMsg = "" + DO i1 = LBOUND(SrcExtPtfm_DataData%x,1), UBOUND(SrcExtPtfm_DataData%x,1) + CALL ExtPtfm_CopyContState( SrcExtPtfm_DataData%x(i1), DstExtPtfm_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcExtPtfm_DataData%xd,1), UBOUND(SrcExtPtfm_DataData%xd,1) + CALL ExtPtfm_CopyDiscState( SrcExtPtfm_DataData%xd(i1), DstExtPtfm_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcExtPtfm_DataData%z,1), UBOUND(SrcExtPtfm_DataData%z,1) + CALL ExtPtfm_CopyConstrState( SrcExtPtfm_DataData%z(i1), DstExtPtfm_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcExtPtfm_DataData%OtherSt,1), UBOUND(SrcExtPtfm_DataData%OtherSt,1) + CALL ExtPtfm_CopyOtherState( SrcExtPtfm_DataData%OtherSt(i1), DstExtPtfm_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + CALL ExtPtfm_CopyParam( SrcExtPtfm_DataData%p, DstExtPtfm_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL ExtPtfm_CopyInput( SrcExtPtfm_DataData%u, DstExtPtfm_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL ExtPtfm_CopyOutput( SrcExtPtfm_DataData%y, DstExtPtfm_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL ExtPtfm_CopyMisc( SrcExtPtfm_DataData%m, DstExtPtfm_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcExtPtfm_DataData%Input)) THEN + i1_l = LBOUND(SrcExtPtfm_DataData%Input,1) + i1_u = UBOUND(SrcExtPtfm_DataData%Input,1) + IF (.NOT. ALLOCATED(DstExtPtfm_DataData%Input)) THEN + ALLOCATE(DstExtPtfm_DataData%Input(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstExtPtfm_DataData%Input.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcExtPtfm_DataData%Input,1), UBOUND(SrcExtPtfm_DataData%Input,1) + CALL ExtPtfm_CopyInput( SrcExtPtfm_DataData%Input(i1), DstExtPtfm_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcExtPtfm_DataData%InputTimes)) THEN + i1_l = LBOUND(SrcExtPtfm_DataData%InputTimes,1) + i1_u = UBOUND(SrcExtPtfm_DataData%InputTimes,1) + IF (.NOT. ALLOCATED(DstExtPtfm_DataData%InputTimes)) THEN + ALLOCATE(DstExtPtfm_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstExtPtfm_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstExtPtfm_DataData%InputTimes = SrcExtPtfm_DataData%InputTimes +ENDIF + END SUBROUTINE FAST_CopyExtPtfm_Data + + SUBROUTINE FAST_DestroyExtPtfm_Data( ExtPtfm_DataData, ErrStat, ErrMsg ) + TYPE(ExtPtfm_Data), INTENT(INOUT) :: ExtPtfm_DataData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyExtPtfm_Data' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +DO i1 = LBOUND(ExtPtfm_DataData%x,1), UBOUND(ExtPtfm_DataData%x,1) + CALL ExtPtfm_DestroyContState( ExtPtfm_DataData%x(i1), ErrStat, ErrMsg ) +ENDDO +DO i1 = LBOUND(ExtPtfm_DataData%xd,1), UBOUND(ExtPtfm_DataData%xd,1) + CALL ExtPtfm_DestroyDiscState( ExtPtfm_DataData%xd(i1), ErrStat, ErrMsg ) +ENDDO +DO i1 = LBOUND(ExtPtfm_DataData%z,1), UBOUND(ExtPtfm_DataData%z,1) + CALL ExtPtfm_DestroyConstrState( ExtPtfm_DataData%z(i1), ErrStat, ErrMsg ) +ENDDO +DO i1 = LBOUND(ExtPtfm_DataData%OtherSt,1), UBOUND(ExtPtfm_DataData%OtherSt,1) + CALL ExtPtfm_DestroyOtherState( ExtPtfm_DataData%OtherSt(i1), ErrStat, ErrMsg ) +ENDDO + CALL ExtPtfm_DestroyParam( ExtPtfm_DataData%p, ErrStat, ErrMsg ) + CALL ExtPtfm_DestroyInput( ExtPtfm_DataData%u, ErrStat, ErrMsg ) + CALL ExtPtfm_DestroyOutput( ExtPtfm_DataData%y, ErrStat, ErrMsg ) + CALL ExtPtfm_DestroyMisc( ExtPtfm_DataData%m, ErrStat, ErrMsg ) +IF (ALLOCATED(ExtPtfm_DataData%Input)) THEN +DO i1 = LBOUND(ExtPtfm_DataData%Input,1), UBOUND(ExtPtfm_DataData%Input,1) + CALL ExtPtfm_DestroyInput( ExtPtfm_DataData%Input(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(ExtPtfm_DataData%Input) +ENDIF +IF (ALLOCATED(ExtPtfm_DataData%InputTimes)) THEN + DEALLOCATE(ExtPtfm_DataData%InputTimes) +ENDIF + END SUBROUTINE FAST_DestroyExtPtfm_Data + + SUBROUTINE FAST_PackExtPtfm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(ExtPtfm_Data), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackExtPtfm_Data' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) + Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype + CALL ExtPtfm_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! x + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! x + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! x + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) + Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype + CALL ExtPtfm_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! xd + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! xd + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! xd + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) + Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype + CALL ExtPtfm_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! z + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! z + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! z + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) + Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype + CALL ExtPtfm_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! OtherSt + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OtherSt + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OtherSt + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype + CALL ExtPtfm_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! p + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! p + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! p + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype + CALL ExtPtfm_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype + CALL ExtPtfm_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! y + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! y + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! y + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype + CALL ExtPtfm_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! m + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! m + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! m + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no + IF ( ALLOCATED(InData%Input) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) + Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype + CALL ExtPtfm_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Input + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Input + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Input + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no + IF ( ALLOCATED(InData%InputTimes) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) + CALL ExtPtfm_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) + CALL ExtPtfm_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) + CALL ExtPtfm_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) + CALL ExtPtfm_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + CALL ExtPtfm_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL ExtPtfm_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL ExtPtfm_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL ExtPtfm_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%Input) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) + CALL ExtPtfm_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%InputTimes) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) + DbKiBuf(Db_Xferred) = InData%InputTimes(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + END SUBROUTINE FAST_PackExtPtfm_Data + + SUBROUTINE FAST_UnPackExtPtfm_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(ExtPtfm_Data), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackExtPtfm_Data' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + i1_l = LBOUND(OutData%x,1) + i1_u = UBOUND(OutData%x,1) + DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL ExtPtfm_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + i1_l = LBOUND(OutData%xd,1) + i1_u = UBOUND(OutData%xd,1) + DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL ExtPtfm_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + i1_l = LBOUND(OutData%z,1) + i1_u = UBOUND(OutData%z,1) + DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL ExtPtfm_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + i1_l = LBOUND(OutData%OtherSt,1) + i1_u = UBOUND(OutData%OtherSt,1) + DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL ExtPtfm_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL ExtPtfm_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL ExtPtfm_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL ExtPtfm_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL ExtPtfm_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Input)) DEALLOCATE(OutData%Input) + ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL ExtPtfm_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%InputTimes)) DEALLOCATE(OutData%InputTimes) + ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) + OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + END SUBROUTINE FAST_UnPackExtPtfm_Data + + SUBROUTINE FAST_CopyHydroDyn_Data( SrcHydroDyn_DataData, DstHydroDyn_DataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(HydroDyn_Data), INTENT(INOUT) :: SrcHydroDyn_DataData + TYPE(HydroDyn_Data), INTENT(INOUT) :: DstHydroDyn_DataData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyHydroDyn_Data' +! + ErrStat = ErrID_None + ErrMsg = "" + DO i1 = LBOUND(SrcHydroDyn_DataData%x,1), UBOUND(SrcHydroDyn_DataData%x,1) + CALL HydroDyn_CopyContState( SrcHydroDyn_DataData%x(i1), DstHydroDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcHydroDyn_DataData%xd,1), UBOUND(SrcHydroDyn_DataData%xd,1) + CALL HydroDyn_CopyDiscState( SrcHydroDyn_DataData%xd(i1), DstHydroDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcHydroDyn_DataData%z,1), UBOUND(SrcHydroDyn_DataData%z,1) + CALL HydroDyn_CopyConstrState( SrcHydroDyn_DataData%z(i1), DstHydroDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcHydroDyn_DataData%OtherSt,1), UBOUND(SrcHydroDyn_DataData%OtherSt,1) + CALL HydroDyn_CopyOtherState( SrcHydroDyn_DataData%OtherSt(i1), DstHydroDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + CALL HydroDyn_CopyParam( SrcHydroDyn_DataData%p, DstHydroDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL HydroDyn_CopyInput( SrcHydroDyn_DataData%u, DstHydroDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL HydroDyn_CopyOutput( SrcHydroDyn_DataData%y, DstHydroDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL HydroDyn_CopyMisc( SrcHydroDyn_DataData%m, DstHydroDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcHydroDyn_DataData%Output)) THEN + i1_l = LBOUND(SrcHydroDyn_DataData%Output,1) + i1_u = UBOUND(SrcHydroDyn_DataData%Output,1) + IF (.NOT. ALLOCATED(DstHydroDyn_DataData%Output)) THEN + ALLOCATE(DstHydroDyn_DataData%Output(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstHydroDyn_DataData%Output.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcHydroDyn_DataData%Output,1), UBOUND(SrcHydroDyn_DataData%Output,1) + CALL HydroDyn_CopyOutput( SrcHydroDyn_DataData%Output(i1), DstHydroDyn_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF + CALL HydroDyn_CopyOutput( SrcHydroDyn_DataData%y_interp, DstHydroDyn_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcHydroDyn_DataData%Input)) THEN + i1_l = LBOUND(SrcHydroDyn_DataData%Input,1) + i1_u = UBOUND(SrcHydroDyn_DataData%Input,1) + IF (.NOT. ALLOCATED(DstHydroDyn_DataData%Input)) THEN + ALLOCATE(DstHydroDyn_DataData%Input(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstHydroDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcHydroDyn_DataData%Input,1), UBOUND(SrcHydroDyn_DataData%Input,1) + CALL HydroDyn_CopyInput( SrcHydroDyn_DataData%Input(i1), DstHydroDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcHydroDyn_DataData%InputTimes)) THEN + i1_l = LBOUND(SrcHydroDyn_DataData%InputTimes,1) + i1_u = UBOUND(SrcHydroDyn_DataData%InputTimes,1) + IF (.NOT. ALLOCATED(DstHydroDyn_DataData%InputTimes)) THEN + ALLOCATE(DstHydroDyn_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstHydroDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstHydroDyn_DataData%InputTimes = SrcHydroDyn_DataData%InputTimes +ENDIF + END SUBROUTINE FAST_CopyHydroDyn_Data + + SUBROUTINE FAST_DestroyHydroDyn_Data( HydroDyn_DataData, ErrStat, ErrMsg ) + TYPE(HydroDyn_Data), INTENT(INOUT) :: HydroDyn_DataData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyHydroDyn_Data' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +DO i1 = LBOUND(HydroDyn_DataData%x,1), UBOUND(HydroDyn_DataData%x,1) + CALL HydroDyn_DestroyContState( HydroDyn_DataData%x(i1), ErrStat, ErrMsg ) +ENDDO +DO i1 = LBOUND(HydroDyn_DataData%xd,1), UBOUND(HydroDyn_DataData%xd,1) + CALL HydroDyn_DestroyDiscState( HydroDyn_DataData%xd(i1), ErrStat, ErrMsg ) +ENDDO +DO i1 = LBOUND(HydroDyn_DataData%z,1), UBOUND(HydroDyn_DataData%z,1) + CALL HydroDyn_DestroyConstrState( HydroDyn_DataData%z(i1), ErrStat, ErrMsg ) +ENDDO +DO i1 = LBOUND(HydroDyn_DataData%OtherSt,1), UBOUND(HydroDyn_DataData%OtherSt,1) + CALL HydroDyn_DestroyOtherState( HydroDyn_DataData%OtherSt(i1), ErrStat, ErrMsg ) +ENDDO + CALL HydroDyn_DestroyParam( HydroDyn_DataData%p, ErrStat, ErrMsg ) + CALL HydroDyn_DestroyInput( HydroDyn_DataData%u, ErrStat, ErrMsg ) + CALL HydroDyn_DestroyOutput( HydroDyn_DataData%y, ErrStat, ErrMsg ) + CALL HydroDyn_DestroyMisc( HydroDyn_DataData%m, ErrStat, ErrMsg ) +IF (ALLOCATED(HydroDyn_DataData%Output)) THEN +DO i1 = LBOUND(HydroDyn_DataData%Output,1), UBOUND(HydroDyn_DataData%Output,1) + CALL HydroDyn_DestroyOutput( HydroDyn_DataData%Output(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(HydroDyn_DataData%Output) +ENDIF + CALL HydroDyn_DestroyOutput( HydroDyn_DataData%y_interp, ErrStat, ErrMsg ) +IF (ALLOCATED(HydroDyn_DataData%Input)) THEN +DO i1 = LBOUND(HydroDyn_DataData%Input,1), UBOUND(HydroDyn_DataData%Input,1) + CALL HydroDyn_DestroyInput( HydroDyn_DataData%Input(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(HydroDyn_DataData%Input) +ENDIF +IF (ALLOCATED(HydroDyn_DataData%InputTimes)) THEN + DEALLOCATE(HydroDyn_DataData%InputTimes) +ENDIF + END SUBROUTINE FAST_DestroyHydroDyn_Data + + SUBROUTINE FAST_PackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(HydroDyn_Data), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackHydroDyn_Data' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) + Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype + CALL HydroDyn_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! x + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! x + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! x + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) + Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype + CALL HydroDyn_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! xd + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! xd + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! xd + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) + Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype + CALL HydroDyn_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! z + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! z + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! z + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) + Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype + CALL HydroDyn_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! OtherSt + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OtherSt + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OtherSt + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype + CALL HydroDyn_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! p + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! p + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! p + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype + CALL HydroDyn_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype + CALL HydroDyn_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! y + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! y + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! y + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype + CALL HydroDyn_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! m + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! m + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! m + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! Output allocated yes/no + IF ( ALLOCATED(InData%Output) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Output upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) + Int_BufSz = Int_BufSz + 3 ! Output: size of buffers for each call to pack subtype + CALL HydroDyn_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Output + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Output + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Output + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Output + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 3 ! y_interp: size of buffers for each call to pack subtype + CALL HydroDyn_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, .TRUE. ) ! y_interp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! y_interp + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! y_interp + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! y_interp + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no + IF ( ALLOCATED(InData%Input) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) + Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype + CALL HydroDyn_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Input + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Input + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Input + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no + IF ( ALLOCATED(InData%InputTimes) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) + CALL HydroDyn_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) + CALL HydroDyn_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) + CALL HydroDyn_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) + CALL HydroDyn_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + CALL HydroDyn_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL HydroDyn_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL HydroDyn_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL HydroDyn_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%Output) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Output,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Output,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) + CALL HydroDyn_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, OnlySize ) ! Output + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + CALL HydroDyn_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, OnlySize ) ! y_interp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%Input) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) + CALL HydroDyn_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%InputTimes) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) + DbKiBuf(Db_Xferred) = InData%InputTimes(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + END SUBROUTINE FAST_PackHydroDyn_Data + + SUBROUTINE FAST_UnPackHydroDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(HydroDyn_Data), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackHydroDyn_Data' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + i1_l = LBOUND(OutData%x,1) + i1_u = UBOUND(OutData%x,1) + DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL HydroDyn_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + i1_l = LBOUND(OutData%xd,1) + i1_u = UBOUND(OutData%xd,1) + DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL HydroDyn_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + i1_l = LBOUND(OutData%z,1) + i1_u = UBOUND(OutData%z,1) + DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL HydroDyn_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + i1_l = LBOUND(OutData%OtherSt,1) + i1_u = UBOUND(OutData%OtherSt,1) + DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL HydroDyn_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL HydroDyn_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL HydroDyn_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL HydroDyn_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL HydroDyn_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Output not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Output)) DEALLOCATE(OutData%Output) + ALLOCATE(OutData%Output(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Output,1), UBOUND(OutData%Output,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL HydroDyn_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%Output(i1), ErrStat2, ErrMsg2 ) ! Output + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL HydroDyn_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_interp, ErrStat2, ErrMsg2 ) ! y_interp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Input)) DEALLOCATE(OutData%Input) + ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL HydroDyn_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%InputTimes)) DEALLOCATE(OutData%InputTimes) + ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) + OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + END SUBROUTINE FAST_UnPackHydroDyn_Data + + SUBROUTINE FAST_CopyIceFloe_Data( SrcIceFloe_DataData, DstIceFloe_DataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(IceFloe_Data), INTENT(INOUT) :: SrcIceFloe_DataData + TYPE(IceFloe_Data), INTENT(INOUT) :: DstIceFloe_DataData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyIceFloe_Data' +! + ErrStat = ErrID_None + ErrMsg = "" + DO i1 = LBOUND(SrcIceFloe_DataData%x,1), UBOUND(SrcIceFloe_DataData%x,1) + CALL IceFloe_CopyContState( SrcIceFloe_DataData%x(i1), DstIceFloe_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcIceFloe_DataData%xd,1), UBOUND(SrcIceFloe_DataData%xd,1) + CALL IceFloe_CopyDiscState( SrcIceFloe_DataData%xd(i1), DstIceFloe_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcIceFloe_DataData%z,1), UBOUND(SrcIceFloe_DataData%z,1) + CALL IceFloe_CopyConstrState( SrcIceFloe_DataData%z(i1), DstIceFloe_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcIceFloe_DataData%OtherSt,1), UBOUND(SrcIceFloe_DataData%OtherSt,1) + CALL IceFloe_CopyOtherState( SrcIceFloe_DataData%OtherSt(i1), DstIceFloe_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + CALL IceFloe_CopyParam( SrcIceFloe_DataData%p, DstIceFloe_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL IceFloe_CopyInput( SrcIceFloe_DataData%u, DstIceFloe_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL IceFloe_CopyOutput( SrcIceFloe_DataData%y, DstIceFloe_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL IceFloe_CopyMisc( SrcIceFloe_DataData%m, DstIceFloe_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcIceFloe_DataData%Input)) THEN + i1_l = LBOUND(SrcIceFloe_DataData%Input,1) + i1_u = UBOUND(SrcIceFloe_DataData%Input,1) + IF (.NOT. ALLOCATED(DstIceFloe_DataData%Input)) THEN + ALLOCATE(DstIceFloe_DataData%Input(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceFloe_DataData%Input.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcIceFloe_DataData%Input,1), UBOUND(SrcIceFloe_DataData%Input,1) + CALL IceFloe_CopyInput( SrcIceFloe_DataData%Input(i1), DstIceFloe_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcIceFloe_DataData%InputTimes)) THEN + i1_l = LBOUND(SrcIceFloe_DataData%InputTimes,1) + i1_u = UBOUND(SrcIceFloe_DataData%InputTimes,1) + IF (.NOT. ALLOCATED(DstIceFloe_DataData%InputTimes)) THEN + ALLOCATE(DstIceFloe_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstIceFloe_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstIceFloe_DataData%InputTimes = SrcIceFloe_DataData%InputTimes +ENDIF + END SUBROUTINE FAST_CopyIceFloe_Data + + SUBROUTINE FAST_DestroyIceFloe_Data( IceFloe_DataData, ErrStat, ErrMsg ) + TYPE(IceFloe_Data), INTENT(INOUT) :: IceFloe_DataData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyIceFloe_Data' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +DO i1 = LBOUND(IceFloe_DataData%x,1), UBOUND(IceFloe_DataData%x,1) + CALL IceFloe_DestroyContState( IceFloe_DataData%x(i1), ErrStat, ErrMsg ) +ENDDO +DO i1 = LBOUND(IceFloe_DataData%xd,1), UBOUND(IceFloe_DataData%xd,1) + CALL IceFloe_DestroyDiscState( IceFloe_DataData%xd(i1), ErrStat, ErrMsg ) +ENDDO +DO i1 = LBOUND(IceFloe_DataData%z,1), UBOUND(IceFloe_DataData%z,1) + CALL IceFloe_DestroyConstrState( IceFloe_DataData%z(i1), ErrStat, ErrMsg ) +ENDDO +DO i1 = LBOUND(IceFloe_DataData%OtherSt,1), UBOUND(IceFloe_DataData%OtherSt,1) + CALL IceFloe_DestroyOtherState( IceFloe_DataData%OtherSt(i1), ErrStat, ErrMsg ) +ENDDO + CALL IceFloe_DestroyParam( IceFloe_DataData%p, ErrStat, ErrMsg ) + CALL IceFloe_DestroyInput( IceFloe_DataData%u, ErrStat, ErrMsg ) + CALL IceFloe_DestroyOutput( IceFloe_DataData%y, ErrStat, ErrMsg ) + CALL IceFloe_DestroyMisc( IceFloe_DataData%m, ErrStat, ErrMsg ) +IF (ALLOCATED(IceFloe_DataData%Input)) THEN +DO i1 = LBOUND(IceFloe_DataData%Input,1), UBOUND(IceFloe_DataData%Input,1) + CALL IceFloe_DestroyInput( IceFloe_DataData%Input(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(IceFloe_DataData%Input) +ENDIF +IF (ALLOCATED(IceFloe_DataData%InputTimes)) THEN + DEALLOCATE(IceFloe_DataData%InputTimes) +ENDIF + END SUBROUTINE FAST_DestroyIceFloe_Data + + SUBROUTINE FAST_PackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(IceFloe_Data), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackIceFloe_Data' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) + Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype + CALL IceFloe_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! x + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! x + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! x + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) + Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype + CALL IceFloe_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! xd + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! xd + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! xd + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) + Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype + CALL IceFloe_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! z + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! z + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! z + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) + Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype + CALL IceFloe_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! OtherSt + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OtherSt + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OtherSt + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype + CALL IceFloe_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! p + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! p + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! p + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype + CALL IceFloe_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype + CALL IceFloe_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! y + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! y + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! y + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype + CALL IceFloe_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! m + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! m + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! m + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no + IF ( ALLOCATED(InData%Input) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) + Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype + CALL IceFloe_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Input + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Input + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Input + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no + IF ( ALLOCATED(InData%InputTimes) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) + CALL IceFloe_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) + CALL IceFloe_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) + CALL IceFloe_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) + CALL IceFloe_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + CALL IceFloe_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL IceFloe_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL IceFloe_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL IceFloe_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%Input) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) + CALL IceFloe_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%InputTimes) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) + DbKiBuf(Db_Xferred) = InData%InputTimes(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + END SUBROUTINE FAST_PackIceFloe_Data + + SUBROUTINE FAST_UnPackIceFloe_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(IceFloe_Data), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackIceFloe_Data' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + i1_l = LBOUND(OutData%x,1) + i1_u = UBOUND(OutData%x,1) + DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL IceFloe_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + i1_l = LBOUND(OutData%xd,1) + i1_u = UBOUND(OutData%xd,1) + DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL IceFloe_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + i1_l = LBOUND(OutData%z,1) + i1_u = UBOUND(OutData%z,1) + DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL IceFloe_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + i1_l = LBOUND(OutData%OtherSt,1) + i1_u = UBOUND(OutData%OtherSt,1) + DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL IceFloe_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL IceFloe_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL IceFloe_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL IceFloe_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL IceFloe_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Input)) DEALLOCATE(OutData%Input) + ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL IceFloe_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%InputTimes)) DEALLOCATE(OutData%InputTimes) + ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) + OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + END SUBROUTINE FAST_UnPackIceFloe_Data + + SUBROUTINE FAST_CopyMAP_Data( SrcMAP_DataData, DstMAP_DataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(MAP_Data), INTENT(INOUT) :: SrcMAP_DataData + TYPE(MAP_Data), INTENT(INOUT) :: DstMAP_DataData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyMAP_Data' +! + ErrStat = ErrID_None + ErrMsg = "" + DO i1 = LBOUND(SrcMAP_DataData%x,1), UBOUND(SrcMAP_DataData%x,1) + CALL MAP_CopyContState( SrcMAP_DataData%x(i1), DstMAP_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcMAP_DataData%xd,1), UBOUND(SrcMAP_DataData%xd,1) + CALL MAP_CopyDiscState( SrcMAP_DataData%xd(i1), DstMAP_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcMAP_DataData%z,1), UBOUND(SrcMAP_DataData%z,1) + CALL MAP_CopyConstrState( SrcMAP_DataData%z(i1), DstMAP_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + CALL MAP_CopyOtherState( SrcMAP_DataData%OtherSt, DstMAP_DataData%OtherSt, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MAP_CopyParam( SrcMAP_DataData%p, DstMAP_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MAP_CopyInput( SrcMAP_DataData%u, DstMAP_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MAP_CopyOutput( SrcMAP_DataData%y, DstMAP_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MAP_CopyOtherState( SrcMAP_DataData%OtherSt_old, DstMAP_DataData%OtherSt_old, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcMAP_DataData%Output)) THEN + i1_l = LBOUND(SrcMAP_DataData%Output,1) + i1_u = UBOUND(SrcMAP_DataData%Output,1) + IF (.NOT. ALLOCATED(DstMAP_DataData%Output)) THEN + ALLOCATE(DstMAP_DataData%Output(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMAP_DataData%Output.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcMAP_DataData%Output,1), UBOUND(SrcMAP_DataData%Output,1) + CALL MAP_CopyOutput( SrcMAP_DataData%Output(i1), DstMAP_DataData%Output(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF + CALL MAP_CopyOutput( SrcMAP_DataData%y_interp, DstMAP_DataData%y_interp, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcMAP_DataData%Input)) THEN + i1_l = LBOUND(SrcMAP_DataData%Input,1) + i1_u = UBOUND(SrcMAP_DataData%Input,1) + IF (.NOT. ALLOCATED(DstMAP_DataData%Input)) THEN + ALLOCATE(DstMAP_DataData%Input(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMAP_DataData%Input.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcMAP_DataData%Input,1), UBOUND(SrcMAP_DataData%Input,1) + CALL MAP_CopyInput( SrcMAP_DataData%Input(i1), DstMAP_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcMAP_DataData%InputTimes)) THEN + i1_l = LBOUND(SrcMAP_DataData%InputTimes,1) + i1_u = UBOUND(SrcMAP_DataData%InputTimes,1) + IF (.NOT. ALLOCATED(DstMAP_DataData%InputTimes)) THEN + ALLOCATE(DstMAP_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMAP_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMAP_DataData%InputTimes = SrcMAP_DataData%InputTimes +ENDIF + END SUBROUTINE FAST_CopyMAP_Data + + SUBROUTINE FAST_DestroyMAP_Data( MAP_DataData, ErrStat, ErrMsg ) + TYPE(MAP_Data), INTENT(INOUT) :: MAP_DataData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyMAP_Data' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +DO i1 = LBOUND(MAP_DataData%x,1), UBOUND(MAP_DataData%x,1) + CALL MAP_DestroyContState( MAP_DataData%x(i1), ErrStat, ErrMsg ) +ENDDO +DO i1 = LBOUND(MAP_DataData%xd,1), UBOUND(MAP_DataData%xd,1) + CALL MAP_DestroyDiscState( MAP_DataData%xd(i1), ErrStat, ErrMsg ) +ENDDO +DO i1 = LBOUND(MAP_DataData%z,1), UBOUND(MAP_DataData%z,1) + CALL MAP_DestroyConstrState( MAP_DataData%z(i1), ErrStat, ErrMsg ) +ENDDO + CALL MAP_DestroyOtherState( MAP_DataData%OtherSt, ErrStat, ErrMsg ) + CALL MAP_DestroyParam( MAP_DataData%p, ErrStat, ErrMsg ) + CALL MAP_DestroyInput( MAP_DataData%u, ErrStat, ErrMsg ) + CALL MAP_DestroyOutput( MAP_DataData%y, ErrStat, ErrMsg ) + CALL MAP_DestroyOtherState( MAP_DataData%OtherSt_old, ErrStat, ErrMsg ) +IF (ALLOCATED(MAP_DataData%Output)) THEN +DO i1 = LBOUND(MAP_DataData%Output,1), UBOUND(MAP_DataData%Output,1) + CALL MAP_DestroyOutput( MAP_DataData%Output(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(MAP_DataData%Output) +ENDIF + CALL MAP_DestroyOutput( MAP_DataData%y_interp, ErrStat, ErrMsg ) +IF (ALLOCATED(MAP_DataData%Input)) THEN +DO i1 = LBOUND(MAP_DataData%Input,1), UBOUND(MAP_DataData%Input,1) + CALL MAP_DestroyInput( MAP_DataData%Input(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(MAP_DataData%Input) +ENDIF +IF (ALLOCATED(MAP_DataData%InputTimes)) THEN + DEALLOCATE(MAP_DataData%InputTimes) +ENDIF + END SUBROUTINE FAST_DestroyMAP_Data + + SUBROUTINE FAST_PackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(MAP_Data), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackMAP_Data' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) + Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype + CALL MAP_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! x + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! x + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! x + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) + Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype + CALL MAP_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! xd + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! xd + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! xd + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) + Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype + CALL MAP_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! z + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! z + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! z + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype + CALL MAP_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt, ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! OtherSt + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OtherSt + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OtherSt + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype + CALL MAP_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! p + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! p + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! p + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype + CALL MAP_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype + CALL MAP_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! y + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! y + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! y + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! OtherSt_old: size of buffers for each call to pack subtype + CALL MAP_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_old, ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt_old + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! OtherSt_old + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OtherSt_old + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OtherSt_old + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! Output allocated yes/no + IF ( ALLOCATED(InData%Output) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Output upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) + Int_BufSz = Int_BufSz + 3 ! Output: size of buffers for each call to pack subtype + CALL MAP_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Output + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Output + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Output + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Output + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 3 ! y_interp: size of buffers for each call to pack subtype + CALL MAP_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, .TRUE. ) ! y_interp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! y_interp + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! y_interp + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! y_interp + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no + IF ( ALLOCATED(InData%Input) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) + Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype + CALL MAP_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Input + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Input + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Input + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no + IF ( ALLOCATED(InData%InputTimes) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) + CALL MAP_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) + CALL MAP_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) + CALL MAP_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + CALL MAP_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt, ErrStat2, ErrMsg2, OnlySize ) ! OtherSt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL MAP_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL MAP_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL MAP_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL MAP_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt_old, ErrStat2, ErrMsg2, OnlySize ) ! OtherSt_old + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%Output) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Output,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Output,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Output,1), UBOUND(InData%Output,1) + CALL MAP_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%Output(i1), ErrStat2, ErrMsg2, OnlySize ) ! Output + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + CALL MAP_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y_interp, ErrStat2, ErrMsg2, OnlySize ) ! y_interp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%Input) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) + CALL MAP_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%InputTimes) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) + DbKiBuf(Db_Xferred) = InData%InputTimes(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + END SUBROUTINE FAST_PackMAP_Data + + SUBROUTINE FAST_UnPackMAP_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(MAP_Data), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackMAP_Data' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + i1_l = LBOUND(OutData%x,1) + i1_u = UBOUND(OutData%x,1) + DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MAP_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + i1_l = LBOUND(OutData%xd,1) + i1_u = UBOUND(OutData%xd,1) + DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MAP_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + i1_l = LBOUND(OutData%z,1) + i1_u = UBOUND(OutData%z,1) + DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MAP_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MAP_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt, ErrStat2, ErrMsg2 ) ! OtherSt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MAP_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MAP_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MAP_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MAP_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt_old, ErrStat2, ErrMsg2 ) ! OtherSt_old + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Output not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Output)) DEALLOCATE(OutData%Output) + ALLOCATE(OutData%Output(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Output.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Output,1), UBOUND(OutData%Output,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MAP_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%Output(i1), ErrStat2, ErrMsg2 ) ! Output + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MAP_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y_interp, ErrStat2, ErrMsg2 ) ! y_interp + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Input)) DEALLOCATE(OutData%Input) + ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MAP_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%InputTimes)) DEALLOCATE(OutData%InputTimes) + ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) + OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + END SUBROUTINE FAST_UnPackMAP_Data + + SUBROUTINE FAST_CopyFEAMooring_Data( SrcFEAMooring_DataData, DstFEAMooring_DataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(FEAMooring_Data), INTENT(INOUT) :: SrcFEAMooring_DataData + TYPE(FEAMooring_Data), INTENT(INOUT) :: DstFEAMooring_DataData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyFEAMooring_Data' +! + ErrStat = ErrID_None + ErrMsg = "" + DO i1 = LBOUND(SrcFEAMooring_DataData%x,1), UBOUND(SrcFEAMooring_DataData%x,1) + CALL FEAM_CopyContState( SrcFEAMooring_DataData%x(i1), DstFEAMooring_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcFEAMooring_DataData%xd,1), UBOUND(SrcFEAMooring_DataData%xd,1) + CALL FEAM_CopyDiscState( SrcFEAMooring_DataData%xd(i1), DstFEAMooring_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcFEAMooring_DataData%z,1), UBOUND(SrcFEAMooring_DataData%z,1) + CALL FEAM_CopyConstrState( SrcFEAMooring_DataData%z(i1), DstFEAMooring_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcFEAMooring_DataData%OtherSt,1), UBOUND(SrcFEAMooring_DataData%OtherSt,1) + CALL FEAM_CopyOtherState( SrcFEAMooring_DataData%OtherSt(i1), DstFEAMooring_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + CALL FEAM_CopyParam( SrcFEAMooring_DataData%p, DstFEAMooring_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL FEAM_CopyInput( SrcFEAMooring_DataData%u, DstFEAMooring_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL FEAM_CopyOutput( SrcFEAMooring_DataData%y, DstFEAMooring_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL FEAM_CopyMisc( SrcFEAMooring_DataData%m, DstFEAMooring_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcFEAMooring_DataData%Input)) THEN + i1_l = LBOUND(SrcFEAMooring_DataData%Input,1) + i1_u = UBOUND(SrcFEAMooring_DataData%Input,1) + IF (.NOT. ALLOCATED(DstFEAMooring_DataData%Input)) THEN + ALLOCATE(DstFEAMooring_DataData%Input(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstFEAMooring_DataData%Input.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcFEAMooring_DataData%Input,1), UBOUND(SrcFEAMooring_DataData%Input,1) + CALL FEAM_CopyInput( SrcFEAMooring_DataData%Input(i1), DstFEAMooring_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcFEAMooring_DataData%InputTimes)) THEN + i1_l = LBOUND(SrcFEAMooring_DataData%InputTimes,1) + i1_u = UBOUND(SrcFEAMooring_DataData%InputTimes,1) + IF (.NOT. ALLOCATED(DstFEAMooring_DataData%InputTimes)) THEN + ALLOCATE(DstFEAMooring_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstFEAMooring_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstFEAMooring_DataData%InputTimes = SrcFEAMooring_DataData%InputTimes +ENDIF + END SUBROUTINE FAST_CopyFEAMooring_Data + + SUBROUTINE FAST_DestroyFEAMooring_Data( FEAMooring_DataData, ErrStat, ErrMsg ) + TYPE(FEAMooring_Data), INTENT(INOUT) :: FEAMooring_DataData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyFEAMooring_Data' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +DO i1 = LBOUND(FEAMooring_DataData%x,1), UBOUND(FEAMooring_DataData%x,1) + CALL FEAM_DestroyContState( FEAMooring_DataData%x(i1), ErrStat, ErrMsg ) +ENDDO +DO i1 = LBOUND(FEAMooring_DataData%xd,1), UBOUND(FEAMooring_DataData%xd,1) + CALL FEAM_DestroyDiscState( FEAMooring_DataData%xd(i1), ErrStat, ErrMsg ) +ENDDO +DO i1 = LBOUND(FEAMooring_DataData%z,1), UBOUND(FEAMooring_DataData%z,1) + CALL FEAM_DestroyConstrState( FEAMooring_DataData%z(i1), ErrStat, ErrMsg ) +ENDDO +DO i1 = LBOUND(FEAMooring_DataData%OtherSt,1), UBOUND(FEAMooring_DataData%OtherSt,1) + CALL FEAM_DestroyOtherState( FEAMooring_DataData%OtherSt(i1), ErrStat, ErrMsg ) +ENDDO + CALL FEAM_DestroyParam( FEAMooring_DataData%p, ErrStat, ErrMsg ) + CALL FEAM_DestroyInput( FEAMooring_DataData%u, ErrStat, ErrMsg ) + CALL FEAM_DestroyOutput( FEAMooring_DataData%y, ErrStat, ErrMsg ) + CALL FEAM_DestroyMisc( FEAMooring_DataData%m, ErrStat, ErrMsg ) +IF (ALLOCATED(FEAMooring_DataData%Input)) THEN +DO i1 = LBOUND(FEAMooring_DataData%Input,1), UBOUND(FEAMooring_DataData%Input,1) + CALL FEAM_DestroyInput( FEAMooring_DataData%Input(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(FEAMooring_DataData%Input) +ENDIF +IF (ALLOCATED(FEAMooring_DataData%InputTimes)) THEN + DEALLOCATE(FEAMooring_DataData%InputTimes) +ENDIF + END SUBROUTINE FAST_DestroyFEAMooring_Data + + SUBROUTINE FAST_PackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(FEAMooring_Data), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackFEAMooring_Data' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) + Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype + CALL FEAM_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! x + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! x + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! x + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) + Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype + CALL FEAM_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! xd + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! xd + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! xd + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) + Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype + CALL FEAM_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! z + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! z + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! z + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) + Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype + CALL FEAM_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! OtherSt + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OtherSt + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OtherSt + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype + CALL FEAM_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! p + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! p + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! p + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype + CALL FEAM_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype + CALL FEAM_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! y + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! y + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! y + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype + CALL FEAM_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! m + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! m + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! m + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no + IF ( ALLOCATED(InData%Input) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) + Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype + CALL FEAM_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Input + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Input + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Input + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no + IF ( ALLOCATED(InData%InputTimes) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) + CALL FEAM_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) + CALL FEAM_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) + CALL FEAM_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) + CALL FEAM_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + CALL FEAM_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL FEAM_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL FEAM_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL FEAM_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%Input) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) + CALL FEAM_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%InputTimes) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) + DbKiBuf(Db_Xferred) = InData%InputTimes(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + END SUBROUTINE FAST_PackFEAMooring_Data + + SUBROUTINE FAST_UnPackFEAMooring_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(FEAMooring_Data), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackFEAMooring_Data' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + i1_l = LBOUND(OutData%x,1) + i1_u = UBOUND(OutData%x,1) + DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL FEAM_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + i1_l = LBOUND(OutData%xd,1) + i1_u = UBOUND(OutData%xd,1) + DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL FEAM_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + i1_l = LBOUND(OutData%z,1) + i1_u = UBOUND(OutData%z,1) + DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL FEAM_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + i1_l = LBOUND(OutData%OtherSt,1) + i1_u = UBOUND(OutData%OtherSt,1) + DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL FEAM_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL FEAM_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL FEAM_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL FEAM_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL FEAM_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Input)) DEALLOCATE(OutData%Input) + ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL FEAM_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%InputTimes)) DEALLOCATE(OutData%InputTimes) + ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) + OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + END SUBROUTINE FAST_UnPackFEAMooring_Data + + SUBROUTINE FAST_CopyMoorDyn_Data( SrcMoorDyn_DataData, DstMoorDyn_DataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(MoorDyn_Data), INTENT(INOUT) :: SrcMoorDyn_DataData + TYPE(MoorDyn_Data), INTENT(INOUT) :: DstMoorDyn_DataData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyMoorDyn_Data' +! + ErrStat = ErrID_None + ErrMsg = "" + DO i1 = LBOUND(SrcMoorDyn_DataData%x,1), UBOUND(SrcMoorDyn_DataData%x,1) + CALL MD_CopyContState( SrcMoorDyn_DataData%x(i1), DstMoorDyn_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcMoorDyn_DataData%xd,1), UBOUND(SrcMoorDyn_DataData%xd,1) + CALL MD_CopyDiscState( SrcMoorDyn_DataData%xd(i1), DstMoorDyn_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcMoorDyn_DataData%z,1), UBOUND(SrcMoorDyn_DataData%z,1) + CALL MD_CopyConstrState( SrcMoorDyn_DataData%z(i1), DstMoorDyn_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcMoorDyn_DataData%OtherSt,1), UBOUND(SrcMoorDyn_DataData%OtherSt,1) + CALL MD_CopyOtherState( SrcMoorDyn_DataData%OtherSt(i1), DstMoorDyn_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + CALL MD_CopyParam( SrcMoorDyn_DataData%p, DstMoorDyn_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MD_CopyInput( SrcMoorDyn_DataData%u, DstMoorDyn_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MD_CopyOutput( SrcMoorDyn_DataData%y, DstMoorDyn_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MD_CopyMisc( SrcMoorDyn_DataData%m, DstMoorDyn_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcMoorDyn_DataData%Input)) THEN + i1_l = LBOUND(SrcMoorDyn_DataData%Input,1) + i1_u = UBOUND(SrcMoorDyn_DataData%Input,1) + IF (.NOT. ALLOCATED(DstMoorDyn_DataData%Input)) THEN + ALLOCATE(DstMoorDyn_DataData%Input(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMoorDyn_DataData%Input.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcMoorDyn_DataData%Input,1), UBOUND(SrcMoorDyn_DataData%Input,1) + CALL MD_CopyInput( SrcMoorDyn_DataData%Input(i1), DstMoorDyn_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcMoorDyn_DataData%InputTimes)) THEN + i1_l = LBOUND(SrcMoorDyn_DataData%InputTimes,1) + i1_u = UBOUND(SrcMoorDyn_DataData%InputTimes,1) + IF (.NOT. ALLOCATED(DstMoorDyn_DataData%InputTimes)) THEN + ALLOCATE(DstMoorDyn_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstMoorDyn_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstMoorDyn_DataData%InputTimes = SrcMoorDyn_DataData%InputTimes +ENDIF + END SUBROUTINE FAST_CopyMoorDyn_Data + + SUBROUTINE FAST_DestroyMoorDyn_Data( MoorDyn_DataData, ErrStat, ErrMsg ) + TYPE(MoorDyn_Data), INTENT(INOUT) :: MoorDyn_DataData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyMoorDyn_Data' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +DO i1 = LBOUND(MoorDyn_DataData%x,1), UBOUND(MoorDyn_DataData%x,1) + CALL MD_DestroyContState( MoorDyn_DataData%x(i1), ErrStat, ErrMsg ) +ENDDO +DO i1 = LBOUND(MoorDyn_DataData%xd,1), UBOUND(MoorDyn_DataData%xd,1) + CALL MD_DestroyDiscState( MoorDyn_DataData%xd(i1), ErrStat, ErrMsg ) +ENDDO +DO i1 = LBOUND(MoorDyn_DataData%z,1), UBOUND(MoorDyn_DataData%z,1) + CALL MD_DestroyConstrState( MoorDyn_DataData%z(i1), ErrStat, ErrMsg ) +ENDDO +DO i1 = LBOUND(MoorDyn_DataData%OtherSt,1), UBOUND(MoorDyn_DataData%OtherSt,1) + CALL MD_DestroyOtherState( MoorDyn_DataData%OtherSt(i1), ErrStat, ErrMsg ) +ENDDO + CALL MD_DestroyParam( MoorDyn_DataData%p, ErrStat, ErrMsg ) + CALL MD_DestroyInput( MoorDyn_DataData%u, ErrStat, ErrMsg ) + CALL MD_DestroyOutput( MoorDyn_DataData%y, ErrStat, ErrMsg ) + CALL MD_DestroyMisc( MoorDyn_DataData%m, ErrStat, ErrMsg ) +IF (ALLOCATED(MoorDyn_DataData%Input)) THEN +DO i1 = LBOUND(MoorDyn_DataData%Input,1), UBOUND(MoorDyn_DataData%Input,1) + CALL MD_DestroyInput( MoorDyn_DataData%Input(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(MoorDyn_DataData%Input) +ENDIF +IF (ALLOCATED(MoorDyn_DataData%InputTimes)) THEN + DEALLOCATE(MoorDyn_DataData%InputTimes) +ENDIF + END SUBROUTINE FAST_DestroyMoorDyn_Data + + SUBROUTINE FAST_PackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(MoorDyn_Data), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackMoorDyn_Data' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) + Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype + CALL MD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! x + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! x + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! x + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) + Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype + CALL MD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! xd + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! xd + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! xd + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) + Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype + CALL MD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! z + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! z + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! z + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) + Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype + CALL MD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! OtherSt + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OtherSt + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OtherSt + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype + CALL MD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! p + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! p + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! p + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype + CALL MD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype + CALL MD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! y + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! y + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! y + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype + CALL MD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! m + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! m + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! m + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no + IF ( ALLOCATED(InData%Input) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) + Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype + CALL MD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Input + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Input + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Input + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no + IF ( ALLOCATED(InData%InputTimes) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) + CALL MD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) + CALL MD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) + CALL MD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) + CALL MD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + CALL MD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL MD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL MD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL MD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%Input) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) + CALL MD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%InputTimes) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) + DbKiBuf(Db_Xferred) = InData%InputTimes(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + END SUBROUTINE FAST_PackMoorDyn_Data + + SUBROUTINE FAST_UnPackMoorDyn_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(MoorDyn_Data), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackMoorDyn_Data' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + i1_l = LBOUND(OutData%x,1) + i1_u = UBOUND(OutData%x,1) + DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MD_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + i1_l = LBOUND(OutData%xd,1) + i1_u = UBOUND(OutData%xd,1) + DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MD_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + i1_l = LBOUND(OutData%z,1) + i1_u = UBOUND(OutData%z,1) + DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MD_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + i1_l = LBOUND(OutData%OtherSt,1) + i1_u = UBOUND(OutData%OtherSt,1) + DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MD_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MD_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MD_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MD_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Input)) DEALLOCATE(OutData%Input) + ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL MD_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%InputTimes)) DEALLOCATE(OutData%InputTimes) + ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) + OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + END SUBROUTINE FAST_UnPackMoorDyn_Data + + SUBROUTINE FAST_CopyOrcaFlex_Data( SrcOrcaFlex_DataData, DstOrcaFlex_DataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(OrcaFlex_Data), INTENT(INOUT) :: SrcOrcaFlex_DataData + TYPE(OrcaFlex_Data), INTENT(INOUT) :: DstOrcaFlex_DataData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyOrcaFlex_Data' +! + ErrStat = ErrID_None + ErrMsg = "" + DO i1 = LBOUND(SrcOrcaFlex_DataData%x,1), UBOUND(SrcOrcaFlex_DataData%x,1) + CALL Orca_CopyContState( SrcOrcaFlex_DataData%x(i1), DstOrcaFlex_DataData%x(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcOrcaFlex_DataData%xd,1), UBOUND(SrcOrcaFlex_DataData%xd,1) + CALL Orca_CopyDiscState( SrcOrcaFlex_DataData%xd(i1), DstOrcaFlex_DataData%xd(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcOrcaFlex_DataData%z,1), UBOUND(SrcOrcaFlex_DataData%z,1) + CALL Orca_CopyConstrState( SrcOrcaFlex_DataData%z(i1), DstOrcaFlex_DataData%z(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + DO i1 = LBOUND(SrcOrcaFlex_DataData%OtherSt,1), UBOUND(SrcOrcaFlex_DataData%OtherSt,1) + CALL Orca_CopyOtherState( SrcOrcaFlex_DataData%OtherSt(i1), DstOrcaFlex_DataData%OtherSt(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO + CALL Orca_CopyParam( SrcOrcaFlex_DataData%p, DstOrcaFlex_DataData%p, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL Orca_CopyInput( SrcOrcaFlex_DataData%u, DstOrcaFlex_DataData%u, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL Orca_CopyOutput( SrcOrcaFlex_DataData%y, DstOrcaFlex_DataData%y, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL Orca_CopyMisc( SrcOrcaFlex_DataData%m, DstOrcaFlex_DataData%m, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcOrcaFlex_DataData%Input)) THEN + i1_l = LBOUND(SrcOrcaFlex_DataData%Input,1) + i1_u = UBOUND(SrcOrcaFlex_DataData%Input,1) + IF (.NOT. ALLOCATED(DstOrcaFlex_DataData%Input)) THEN + ALLOCATE(DstOrcaFlex_DataData%Input(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOrcaFlex_DataData%Input.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcOrcaFlex_DataData%Input,1), UBOUND(SrcOrcaFlex_DataData%Input,1) + CALL Orca_CopyInput( SrcOrcaFlex_DataData%Input(i1), DstOrcaFlex_DataData%Input(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcOrcaFlex_DataData%InputTimes)) THEN + i1_l = LBOUND(SrcOrcaFlex_DataData%InputTimes,1) + i1_u = UBOUND(SrcOrcaFlex_DataData%InputTimes,1) + IF (.NOT. ALLOCATED(DstOrcaFlex_DataData%InputTimes)) THEN + ALLOCATE(DstOrcaFlex_DataData%InputTimes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstOrcaFlex_DataData%InputTimes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstOrcaFlex_DataData%InputTimes = SrcOrcaFlex_DataData%InputTimes +ENDIF + END SUBROUTINE FAST_CopyOrcaFlex_Data + + SUBROUTINE FAST_DestroyOrcaFlex_Data( OrcaFlex_DataData, ErrStat, ErrMsg ) + TYPE(OrcaFlex_Data), INTENT(INOUT) :: OrcaFlex_DataData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyOrcaFlex_Data' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +DO i1 = LBOUND(OrcaFlex_DataData%x,1), UBOUND(OrcaFlex_DataData%x,1) + CALL Orca_DestroyContState( OrcaFlex_DataData%x(i1), ErrStat, ErrMsg ) +ENDDO +DO i1 = LBOUND(OrcaFlex_DataData%xd,1), UBOUND(OrcaFlex_DataData%xd,1) + CALL Orca_DestroyDiscState( OrcaFlex_DataData%xd(i1), ErrStat, ErrMsg ) +ENDDO +DO i1 = LBOUND(OrcaFlex_DataData%z,1), UBOUND(OrcaFlex_DataData%z,1) + CALL Orca_DestroyConstrState( OrcaFlex_DataData%z(i1), ErrStat, ErrMsg ) +ENDDO +DO i1 = LBOUND(OrcaFlex_DataData%OtherSt,1), UBOUND(OrcaFlex_DataData%OtherSt,1) + CALL Orca_DestroyOtherState( OrcaFlex_DataData%OtherSt(i1), ErrStat, ErrMsg ) +ENDDO + CALL Orca_DestroyParam( OrcaFlex_DataData%p, ErrStat, ErrMsg ) + CALL Orca_DestroyInput( OrcaFlex_DataData%u, ErrStat, ErrMsg ) + CALL Orca_DestroyOutput( OrcaFlex_DataData%y, ErrStat, ErrMsg ) + CALL Orca_DestroyMisc( OrcaFlex_DataData%m, ErrStat, ErrMsg ) +IF (ALLOCATED(OrcaFlex_DataData%Input)) THEN +DO i1 = LBOUND(OrcaFlex_DataData%Input,1), UBOUND(OrcaFlex_DataData%Input,1) + CALL Orca_DestroyInput( OrcaFlex_DataData%Input(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(OrcaFlex_DataData%Input) +ENDIF +IF (ALLOCATED(OrcaFlex_DataData%InputTimes)) THEN + DEALLOCATE(OrcaFlex_DataData%InputTimes) +ENDIF + END SUBROUTINE FAST_DestroyOrcaFlex_Data + + SUBROUTINE FAST_PackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(OrcaFlex_Data), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackOrcaFlex_Data' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) + Int_BufSz = Int_BufSz + 3 ! x: size of buffers for each call to pack subtype + CALL Orca_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, .TRUE. ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! x + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! x + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! x + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) + Int_BufSz = Int_BufSz + 3 ! xd: size of buffers for each call to pack subtype + CALL Orca_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, .TRUE. ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! xd + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! xd + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! xd + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) + Int_BufSz = Int_BufSz + 3 ! z: size of buffers for each call to pack subtype + CALL Orca_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, .TRUE. ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! z + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! z + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! z + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) + Int_BufSz = Int_BufSz + 3 ! OtherSt: size of buffers for each call to pack subtype + CALL Orca_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OtherSt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! OtherSt + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OtherSt + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OtherSt + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + Int_BufSz = Int_BufSz + 3 ! p: size of buffers for each call to pack subtype + CALL Orca_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, .TRUE. ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! p + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! p + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! p + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! u: size of buffers for each call to pack subtype + CALL Orca_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, .TRUE. ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! y: size of buffers for each call to pack subtype + CALL Orca_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, .TRUE. ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! y + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! y + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! y + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! m: size of buffers for each call to pack subtype + CALL Orca_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, .TRUE. ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! m + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! m + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! m + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! Input allocated yes/no + IF ( ALLOCATED(InData%Input) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Input upper/lower bounds for each dimension + DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) + Int_BufSz = Int_BufSz + 3 ! Input: size of buffers for each call to pack subtype + CALL Orca_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, .TRUE. ) ! Input + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Input + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Input + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Input + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! InputTimes allocated yes/no + IF ( ALLOCATED(InData%InputTimes) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! InputTimes upper/lower bounds for each dimension + Db_BufSz = Db_BufSz + SIZE(InData%InputTimes) ! InputTimes + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + DO i1 = LBOUND(InData%x,1), UBOUND(InData%x,1) + CALL Orca_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%x(i1), ErrStat2, ErrMsg2, OnlySize ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + DO i1 = LBOUND(InData%xd,1), UBOUND(InData%xd,1) + CALL Orca_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%xd(i1), ErrStat2, ErrMsg2, OnlySize ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + DO i1 = LBOUND(InData%z,1), UBOUND(InData%z,1) + CALL Orca_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%z(i1), ErrStat2, ErrMsg2, OnlySize ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + DO i1 = LBOUND(InData%OtherSt,1), UBOUND(InData%OtherSt,1) + CALL Orca_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%OtherSt(i1), ErrStat2, ErrMsg2, OnlySize ) ! OtherSt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + CALL Orca_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p, ErrStat2, ErrMsg2, OnlySize ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL Orca_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%u, ErrStat2, ErrMsg2, OnlySize ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL Orca_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%y, ErrStat2, ErrMsg2, OnlySize ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL Orca_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%m, ErrStat2, ErrMsg2, OnlySize ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%Input) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Input,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Input,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Input,1), UBOUND(InData%Input,1) + CALL Orca_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%Input(i1), ErrStat2, ErrMsg2, OnlySize ) ! Input + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%InputTimes) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%InputTimes,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%InputTimes,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%InputTimes,1), UBOUND(InData%InputTimes,1) + DbKiBuf(Db_Xferred) = InData%InputTimes(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + END SUBROUTINE FAST_PackOrcaFlex_Data + + SUBROUTINE FAST_UnPackOrcaFlex_Data( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(OrcaFlex_Data), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackOrcaFlex_Data' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + i1_l = LBOUND(OutData%x,1) + i1_u = UBOUND(OutData%x,1) + DO i1 = LBOUND(OutData%x,1), UBOUND(OutData%x,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL Orca_UnpackContState( Re_Buf, Db_Buf, Int_Buf, OutData%x(i1), ErrStat2, ErrMsg2 ) ! x + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + i1_l = LBOUND(OutData%xd,1) + i1_u = UBOUND(OutData%xd,1) + DO i1 = LBOUND(OutData%xd,1), UBOUND(OutData%xd,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL Orca_UnpackDiscState( Re_Buf, Db_Buf, Int_Buf, OutData%xd(i1), ErrStat2, ErrMsg2 ) ! xd + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + i1_l = LBOUND(OutData%z,1) + i1_u = UBOUND(OutData%z,1) + DO i1 = LBOUND(OutData%z,1), UBOUND(OutData%z,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL Orca_UnpackConstrState( Re_Buf, Db_Buf, Int_Buf, OutData%z(i1), ErrStat2, ErrMsg2 ) ! z + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + i1_l = LBOUND(OutData%OtherSt,1) + i1_u = UBOUND(OutData%OtherSt,1) + DO i1 = LBOUND(OutData%OtherSt,1), UBOUND(OutData%OtherSt,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL Orca_UnpackOtherState( Re_Buf, Db_Buf, Int_Buf, OutData%OtherSt(i1), ErrStat2, ErrMsg2 ) ! OtherSt + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL Orca_UnpackParam( Re_Buf, Db_Buf, Int_Buf, OutData%p, ErrStat2, ErrMsg2 ) ! p + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL Orca_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%u, ErrStat2, ErrMsg2 ) ! u + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL Orca_UnpackOutput( Re_Buf, Db_Buf, Int_Buf, OutData%y, ErrStat2, ErrMsg2 ) ! y + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL Orca_UnpackMisc( Re_Buf, Db_Buf, Int_Buf, OutData%m, ErrStat2, ErrMsg2 ) ! m + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Input not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Input)) DEALLOCATE(OutData%Input) + ALLOCATE(OutData%Input(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Input.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Input,1), UBOUND(OutData%Input,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL Orca_UnpackInput( Re_Buf, Db_Buf, Int_Buf, OutData%Input(i1), ErrStat2, ErrMsg2 ) ! Input + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! InputTimes not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%InputTimes)) DEALLOCATE(OutData%InputTimes) + ALLOCATE(OutData%InputTimes(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%InputTimes.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%InputTimes,1), UBOUND(OutData%InputTimes,1) + OutData%InputTimes(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + END SUBROUTINE FAST_UnPackOrcaFlex_Data + + SUBROUTINE FAST_CopyModuleMapType( SrcModuleMapTypeData, DstModuleMapTypeData, CtrlCode, ErrStat, ErrMsg ) + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: SrcModuleMapTypeData + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: DstModuleMapTypeData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyModuleMapType' +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(SrcModuleMapTypeData%ED_P_2_BD_P)) THEN + i1_l = LBOUND(SrcModuleMapTypeData%ED_P_2_BD_P,1) + i1_u = UBOUND(SrcModuleMapTypeData%ED_P_2_BD_P,1) + IF (.NOT. ALLOCATED(DstModuleMapTypeData%ED_P_2_BD_P)) THEN + ALLOCATE(DstModuleMapTypeData%ED_P_2_BD_P(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%ED_P_2_BD_P.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcModuleMapTypeData%ED_P_2_BD_P,1), UBOUND(SrcModuleMapTypeData%ED_P_2_BD_P,1) + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_BD_P(i1), DstModuleMapTypeData%ED_P_2_BD_P(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcModuleMapTypeData%BD_P_2_ED_P)) THEN + i1_l = LBOUND(SrcModuleMapTypeData%BD_P_2_ED_P,1) + i1_u = UBOUND(SrcModuleMapTypeData%BD_P_2_ED_P,1) + IF (.NOT. ALLOCATED(DstModuleMapTypeData%BD_P_2_ED_P)) THEN + ALLOCATE(DstModuleMapTypeData%BD_P_2_ED_P(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BD_P_2_ED_P.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcModuleMapTypeData%BD_P_2_ED_P,1), UBOUND(SrcModuleMapTypeData%BD_P_2_ED_P,1) + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%BD_P_2_ED_P(i1), DstModuleMapTypeData%BD_P_2_ED_P(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcModuleMapTypeData%ED_P_2_BD_P_Hub)) THEN + i1_l = LBOUND(SrcModuleMapTypeData%ED_P_2_BD_P_Hub,1) + i1_u = UBOUND(SrcModuleMapTypeData%ED_P_2_BD_P_Hub,1) + IF (.NOT. ALLOCATED(DstModuleMapTypeData%ED_P_2_BD_P_Hub)) THEN + ALLOCATE(DstModuleMapTypeData%ED_P_2_BD_P_Hub(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%ED_P_2_BD_P_Hub.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcModuleMapTypeData%ED_P_2_BD_P_Hub,1), UBOUND(SrcModuleMapTypeData%ED_P_2_BD_P_Hub,1) + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_BD_P_Hub(i1), DstModuleMapTypeData%ED_P_2_BD_P_Hub(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_HD_W_P, DstModuleMapTypeData%ED_P_2_HD_W_P, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%HD_W_P_2_ED_P, DstModuleMapTypeData%HD_W_P_2_ED_P, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_HD_M_P, DstModuleMapTypeData%ED_P_2_HD_M_P, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%HD_M_P_2_ED_P, DstModuleMapTypeData%HD_M_P_2_ED_P, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_HD_M_L, DstModuleMapTypeData%ED_P_2_HD_M_L, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%HD_M_L_2_ED_P, DstModuleMapTypeData%HD_M_L_2_ED_P, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_Mooring_P, DstModuleMapTypeData%ED_P_2_Mooring_P, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%Mooring_P_2_ED_P, DstModuleMapTypeData%Mooring_P_2_ED_P, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_SD_TP, DstModuleMapTypeData%ED_P_2_SD_TP, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SD_TP_2_ED_P, DstModuleMapTypeData%SD_TP_2_ED_P, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SD_P_2_HD_M_P, DstModuleMapTypeData%SD_P_2_HD_M_P, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%HD_M_P_2_SD_P, DstModuleMapTypeData%HD_M_P_2_SD_P, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SD_P_2_HD_M_L, DstModuleMapTypeData%SD_P_2_HD_M_L, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%HD_M_L_2_SD_P, DstModuleMapTypeData%HD_M_L_2_SD_P, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_SrvD_P_N, DstModuleMapTypeData%ED_P_2_SrvD_P_N, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SrvD_P_2_ED_P_N, DstModuleMapTypeData%SrvD_P_2_ED_P_N, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_L_2_SrvD_P_T, DstModuleMapTypeData%ED_L_2_SrvD_P_T, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SrvD_P_2_ED_P_T, DstModuleMapTypeData%SrvD_P_2_ED_P_T, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcModuleMapTypeData%BDED_L_2_AD_L_B)) THEN + i1_l = LBOUND(SrcModuleMapTypeData%BDED_L_2_AD_L_B,1) + i1_u = UBOUND(SrcModuleMapTypeData%BDED_L_2_AD_L_B,1) + IF (.NOT. ALLOCATED(DstModuleMapTypeData%BDED_L_2_AD_L_B)) THEN + ALLOCATE(DstModuleMapTypeData%BDED_L_2_AD_L_B(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BDED_L_2_AD_L_B.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcModuleMapTypeData%BDED_L_2_AD_L_B,1), UBOUND(SrcModuleMapTypeData%BDED_L_2_AD_L_B,1) + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%BDED_L_2_AD_L_B(i1), DstModuleMapTypeData%BDED_L_2_AD_L_B(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcModuleMapTypeData%AD_L_2_BDED_B)) THEN + i1_l = LBOUND(SrcModuleMapTypeData%AD_L_2_BDED_B,1) + i1_u = UBOUND(SrcModuleMapTypeData%AD_L_2_BDED_B,1) + IF (.NOT. ALLOCATED(DstModuleMapTypeData%AD_L_2_BDED_B)) THEN + ALLOCATE(DstModuleMapTypeData%AD_L_2_BDED_B(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%AD_L_2_BDED_B.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcModuleMapTypeData%AD_L_2_BDED_B,1), UBOUND(SrcModuleMapTypeData%AD_L_2_BDED_B,1) + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%AD_L_2_BDED_B(i1), DstModuleMapTypeData%AD_L_2_BDED_B(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcModuleMapTypeData%BD_L_2_BD_L)) THEN + i1_l = LBOUND(SrcModuleMapTypeData%BD_L_2_BD_L,1) + i1_u = UBOUND(SrcModuleMapTypeData%BD_L_2_BD_L,1) + IF (.NOT. ALLOCATED(DstModuleMapTypeData%BD_L_2_BD_L)) THEN + ALLOCATE(DstModuleMapTypeData%BD_L_2_BD_L(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%BD_L_2_BD_L.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcModuleMapTypeData%BD_L_2_BD_L,1), UBOUND(SrcModuleMapTypeData%BD_L_2_BD_L,1) + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%BD_L_2_BD_L(i1), DstModuleMapTypeData%BD_L_2_BD_L(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_L_2_AD_L_T, DstModuleMapTypeData%ED_L_2_AD_L_T, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%AD_L_2_ED_P_T, DstModuleMapTypeData%AD_L_2_ED_P_T, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcModuleMapTypeData%ED_P_2_AD_P_R)) THEN + i1_l = LBOUND(SrcModuleMapTypeData%ED_P_2_AD_P_R,1) + i1_u = UBOUND(SrcModuleMapTypeData%ED_P_2_AD_P_R,1) + IF (.NOT. ALLOCATED(DstModuleMapTypeData%ED_P_2_AD_P_R)) THEN + ALLOCATE(DstModuleMapTypeData%ED_P_2_AD_P_R(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%ED_P_2_AD_P_R.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcModuleMapTypeData%ED_P_2_AD_P_R,1), UBOUND(SrcModuleMapTypeData%ED_P_2_AD_P_R,1) + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_AD_P_R(i1), DstModuleMapTypeData%ED_P_2_AD_P_R(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%ED_P_2_AD_P_H, DstModuleMapTypeData%ED_P_2_AD_P_H, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%IceF_P_2_SD_P, DstModuleMapTypeData%IceF_P_2_SD_P, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SD_P_2_IceF_P, DstModuleMapTypeData%SD_P_2_IceF_P, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcModuleMapTypeData%IceD_P_2_SD_P)) THEN + i1_l = LBOUND(SrcModuleMapTypeData%IceD_P_2_SD_P,1) + i1_u = UBOUND(SrcModuleMapTypeData%IceD_P_2_SD_P,1) + IF (.NOT. ALLOCATED(DstModuleMapTypeData%IceD_P_2_SD_P)) THEN + ALLOCATE(DstModuleMapTypeData%IceD_P_2_SD_P(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%IceD_P_2_SD_P.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcModuleMapTypeData%IceD_P_2_SD_P,1), UBOUND(SrcModuleMapTypeData%IceD_P_2_SD_P,1) + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%IceD_P_2_SD_P(i1), DstModuleMapTypeData%IceD_P_2_SD_P(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcModuleMapTypeData%SD_P_2_IceD_P)) THEN + i1_l = LBOUND(SrcModuleMapTypeData%SD_P_2_IceD_P,1) + i1_u = UBOUND(SrcModuleMapTypeData%SD_P_2_IceD_P,1) + IF (.NOT. ALLOCATED(DstModuleMapTypeData%SD_P_2_IceD_P)) THEN + ALLOCATE(DstModuleMapTypeData%SD_P_2_IceD_P(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%SD_P_2_IceD_P.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcModuleMapTypeData%SD_P_2_IceD_P,1), UBOUND(SrcModuleMapTypeData%SD_P_2_IceD_P,1) + CALL NWTC_Library_Copymeshmaptype( SrcModuleMapTypeData%SD_P_2_IceD_P(i1), DstModuleMapTypeData%SD_P_2_IceD_P(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcModuleMapTypeData%Jacobian_Opt1)) THEN + i1_l = LBOUND(SrcModuleMapTypeData%Jacobian_Opt1,1) + i1_u = UBOUND(SrcModuleMapTypeData%Jacobian_Opt1,1) + i2_l = LBOUND(SrcModuleMapTypeData%Jacobian_Opt1,2) + i2_u = UBOUND(SrcModuleMapTypeData%Jacobian_Opt1,2) + IF (.NOT. ALLOCATED(DstModuleMapTypeData%Jacobian_Opt1)) THEN + ALLOCATE(DstModuleMapTypeData%Jacobian_Opt1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%Jacobian_Opt1.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstModuleMapTypeData%Jacobian_Opt1 = SrcModuleMapTypeData%Jacobian_Opt1 +ENDIF +IF (ALLOCATED(SrcModuleMapTypeData%Jacobian_pivot)) THEN + i1_l = LBOUND(SrcModuleMapTypeData%Jacobian_pivot,1) + i1_u = UBOUND(SrcModuleMapTypeData%Jacobian_pivot,1) + IF (.NOT. ALLOCATED(DstModuleMapTypeData%Jacobian_pivot)) THEN + ALLOCATE(DstModuleMapTypeData%Jacobian_pivot(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%Jacobian_pivot.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstModuleMapTypeData%Jacobian_pivot = SrcModuleMapTypeData%Jacobian_pivot +ENDIF +IF (ALLOCATED(SrcModuleMapTypeData%Jac_u_indx)) THEN + i1_l = LBOUND(SrcModuleMapTypeData%Jac_u_indx,1) + i1_u = UBOUND(SrcModuleMapTypeData%Jac_u_indx,1) + i2_l = LBOUND(SrcModuleMapTypeData%Jac_u_indx,2) + i2_u = UBOUND(SrcModuleMapTypeData%Jac_u_indx,2) + IF (.NOT. ALLOCATED(DstModuleMapTypeData%Jac_u_indx)) THEN + ALLOCATE(DstModuleMapTypeData%Jac_u_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstModuleMapTypeData%Jac_u_indx = SrcModuleMapTypeData%Jac_u_indx +ENDIF + CALL MeshCopy( SrcModuleMapTypeData%u_ED_PlatformPtMesh, DstModuleMapTypeData%u_ED_PlatformPtMesh, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MeshCopy( SrcModuleMapTypeData%u_ED_PlatformPtMesh_2, DstModuleMapTypeData%u_ED_PlatformPtMesh_2, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MeshCopy( SrcModuleMapTypeData%u_SD_TPMesh, DstModuleMapTypeData%u_SD_TPMesh, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MeshCopy( SrcModuleMapTypeData%u_SD_LMesh, DstModuleMapTypeData%u_SD_LMesh, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MeshCopy( SrcModuleMapTypeData%u_SD_LMesh_2, DstModuleMapTypeData%u_SD_LMesh_2, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MeshCopy( SrcModuleMapTypeData%u_HD_M_LumpedMesh, DstModuleMapTypeData%u_HD_M_LumpedMesh, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MeshCopy( SrcModuleMapTypeData%u_HD_M_DistribMesh, DstModuleMapTypeData%u_HD_M_DistribMesh, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MeshCopy( SrcModuleMapTypeData%u_HD_Mesh, DstModuleMapTypeData%u_HD_Mesh, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MeshCopy( SrcModuleMapTypeData%u_ED_HubPtLoad, DstModuleMapTypeData%u_ED_HubPtLoad, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MeshCopy( SrcModuleMapTypeData%u_ED_HubPtLoad_2, DstModuleMapTypeData%u_ED_HubPtLoad_2, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcModuleMapTypeData%u_BD_RootMotion)) THEN + i1_l = LBOUND(SrcModuleMapTypeData%u_BD_RootMotion,1) + i1_u = UBOUND(SrcModuleMapTypeData%u_BD_RootMotion,1) + IF (.NOT. ALLOCATED(DstModuleMapTypeData%u_BD_RootMotion)) THEN + ALLOCATE(DstModuleMapTypeData%u_BD_RootMotion(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%u_BD_RootMotion.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcModuleMapTypeData%u_BD_RootMotion,1), UBOUND(SrcModuleMapTypeData%u_BD_RootMotion,1) + CALL MeshCopy( SrcModuleMapTypeData%u_BD_RootMotion(i1), DstModuleMapTypeData%u_BD_RootMotion(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcModuleMapTypeData%y_BD_BldMotion_4Loads)) THEN + i1_l = LBOUND(SrcModuleMapTypeData%y_BD_BldMotion_4Loads,1) + i1_u = UBOUND(SrcModuleMapTypeData%y_BD_BldMotion_4Loads,1) + IF (.NOT. ALLOCATED(DstModuleMapTypeData%y_BD_BldMotion_4Loads)) THEN + ALLOCATE(DstModuleMapTypeData%y_BD_BldMotion_4Loads(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstModuleMapTypeData%y_BD_BldMotion_4Loads.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcModuleMapTypeData%y_BD_BldMotion_4Loads,1), UBOUND(SrcModuleMapTypeData%y_BD_BldMotion_4Loads,1) + CALL MeshCopy( SrcModuleMapTypeData%y_BD_BldMotion_4Loads(i1), DstModuleMapTypeData%y_BD_BldMotion_4Loads(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF + CALL MeshCopy( SrcModuleMapTypeData%u_Orca_PtfmMesh, DstModuleMapTypeData%u_Orca_PtfmMesh, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MeshCopy( SrcModuleMapTypeData%u_ExtPtfm_PtfmMesh, DstModuleMapTypeData%u_ExtPtfm_PtfmMesh, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + END SUBROUTINE FAST_CopyModuleMapType + + SUBROUTINE FAST_DestroyModuleMapType( ModuleMapTypeData, ErrStat, ErrMsg ) + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: ModuleMapTypeData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyModuleMapType' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" +IF (ALLOCATED(ModuleMapTypeData%ED_P_2_BD_P)) THEN +DO i1 = LBOUND(ModuleMapTypeData%ED_P_2_BD_P,1), UBOUND(ModuleMapTypeData%ED_P_2_BD_P,1) + CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ED_P_2_BD_P(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(ModuleMapTypeData%ED_P_2_BD_P) +ENDIF +IF (ALLOCATED(ModuleMapTypeData%BD_P_2_ED_P)) THEN +DO i1 = LBOUND(ModuleMapTypeData%BD_P_2_ED_P,1), UBOUND(ModuleMapTypeData%BD_P_2_ED_P,1) + CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%BD_P_2_ED_P(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(ModuleMapTypeData%BD_P_2_ED_P) +ENDIF +IF (ALLOCATED(ModuleMapTypeData%ED_P_2_BD_P_Hub)) THEN +DO i1 = LBOUND(ModuleMapTypeData%ED_P_2_BD_P_Hub,1), UBOUND(ModuleMapTypeData%ED_P_2_BD_P_Hub,1) + CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ED_P_2_BD_P_Hub(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(ModuleMapTypeData%ED_P_2_BD_P_Hub) +ENDIF + CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ED_P_2_HD_W_P, ErrStat, ErrMsg ) + CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%HD_W_P_2_ED_P, ErrStat, ErrMsg ) + CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ED_P_2_HD_M_P, ErrStat, ErrMsg ) + CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%HD_M_P_2_ED_P, ErrStat, ErrMsg ) + CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ED_P_2_HD_M_L, ErrStat, ErrMsg ) + CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%HD_M_L_2_ED_P, ErrStat, ErrMsg ) + CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ED_P_2_Mooring_P, ErrStat, ErrMsg ) + CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%Mooring_P_2_ED_P, ErrStat, ErrMsg ) + CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ED_P_2_SD_TP, ErrStat, ErrMsg ) + CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%SD_TP_2_ED_P, ErrStat, ErrMsg ) + CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%SD_P_2_HD_M_P, ErrStat, ErrMsg ) + CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%HD_M_P_2_SD_P, ErrStat, ErrMsg ) + CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%SD_P_2_HD_M_L, ErrStat, ErrMsg ) + CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%HD_M_L_2_SD_P, ErrStat, ErrMsg ) + CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ED_P_2_SrvD_P_N, ErrStat, ErrMsg ) + CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%SrvD_P_2_ED_P_N, ErrStat, ErrMsg ) + CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ED_L_2_SrvD_P_T, ErrStat, ErrMsg ) + CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%SrvD_P_2_ED_P_T, ErrStat, ErrMsg ) +IF (ALLOCATED(ModuleMapTypeData%BDED_L_2_AD_L_B)) THEN +DO i1 = LBOUND(ModuleMapTypeData%BDED_L_2_AD_L_B,1), UBOUND(ModuleMapTypeData%BDED_L_2_AD_L_B,1) + CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%BDED_L_2_AD_L_B(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(ModuleMapTypeData%BDED_L_2_AD_L_B) +ENDIF +IF (ALLOCATED(ModuleMapTypeData%AD_L_2_BDED_B)) THEN +DO i1 = LBOUND(ModuleMapTypeData%AD_L_2_BDED_B,1), UBOUND(ModuleMapTypeData%AD_L_2_BDED_B,1) + CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%AD_L_2_BDED_B(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(ModuleMapTypeData%AD_L_2_BDED_B) +ENDIF +IF (ALLOCATED(ModuleMapTypeData%BD_L_2_BD_L)) THEN +DO i1 = LBOUND(ModuleMapTypeData%BD_L_2_BD_L,1), UBOUND(ModuleMapTypeData%BD_L_2_BD_L,1) + CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%BD_L_2_BD_L(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(ModuleMapTypeData%BD_L_2_BD_L) +ENDIF + CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ED_L_2_AD_L_T, ErrStat, ErrMsg ) + CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%AD_L_2_ED_P_T, ErrStat, ErrMsg ) +IF (ALLOCATED(ModuleMapTypeData%ED_P_2_AD_P_R)) THEN +DO i1 = LBOUND(ModuleMapTypeData%ED_P_2_AD_P_R,1), UBOUND(ModuleMapTypeData%ED_P_2_AD_P_R,1) + CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ED_P_2_AD_P_R(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(ModuleMapTypeData%ED_P_2_AD_P_R) +ENDIF + CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%ED_P_2_AD_P_H, ErrStat, ErrMsg ) + CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%IceF_P_2_SD_P, ErrStat, ErrMsg ) + CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%SD_P_2_IceF_P, ErrStat, ErrMsg ) +IF (ALLOCATED(ModuleMapTypeData%IceD_P_2_SD_P)) THEN +DO i1 = LBOUND(ModuleMapTypeData%IceD_P_2_SD_P,1), UBOUND(ModuleMapTypeData%IceD_P_2_SD_P,1) + CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%IceD_P_2_SD_P(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(ModuleMapTypeData%IceD_P_2_SD_P) +ENDIF +IF (ALLOCATED(ModuleMapTypeData%SD_P_2_IceD_P)) THEN +DO i1 = LBOUND(ModuleMapTypeData%SD_P_2_IceD_P,1), UBOUND(ModuleMapTypeData%SD_P_2_IceD_P,1) + CALL NWTC_Library_Destroymeshmaptype( ModuleMapTypeData%SD_P_2_IceD_P(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(ModuleMapTypeData%SD_P_2_IceD_P) +ENDIF +IF (ALLOCATED(ModuleMapTypeData%Jacobian_Opt1)) THEN + DEALLOCATE(ModuleMapTypeData%Jacobian_Opt1) +ENDIF +IF (ALLOCATED(ModuleMapTypeData%Jacobian_pivot)) THEN + DEALLOCATE(ModuleMapTypeData%Jacobian_pivot) +ENDIF +IF (ALLOCATED(ModuleMapTypeData%Jac_u_indx)) THEN + DEALLOCATE(ModuleMapTypeData%Jac_u_indx) +ENDIF + CALL MeshDestroy( ModuleMapTypeData%u_ED_PlatformPtMesh, ErrStat, ErrMsg ) + CALL MeshDestroy( ModuleMapTypeData%u_ED_PlatformPtMesh_2, ErrStat, ErrMsg ) + CALL MeshDestroy( ModuleMapTypeData%u_SD_TPMesh, ErrStat, ErrMsg ) + CALL MeshDestroy( ModuleMapTypeData%u_SD_LMesh, ErrStat, ErrMsg ) + CALL MeshDestroy( ModuleMapTypeData%u_SD_LMesh_2, ErrStat, ErrMsg ) + CALL MeshDestroy( ModuleMapTypeData%u_HD_M_LumpedMesh, ErrStat, ErrMsg ) + CALL MeshDestroy( ModuleMapTypeData%u_HD_M_DistribMesh, ErrStat, ErrMsg ) + CALL MeshDestroy( ModuleMapTypeData%u_HD_Mesh, ErrStat, ErrMsg ) + CALL MeshDestroy( ModuleMapTypeData%u_ED_HubPtLoad, ErrStat, ErrMsg ) + CALL MeshDestroy( ModuleMapTypeData%u_ED_HubPtLoad_2, ErrStat, ErrMsg ) +IF (ALLOCATED(ModuleMapTypeData%u_BD_RootMotion)) THEN +DO i1 = LBOUND(ModuleMapTypeData%u_BD_RootMotion,1), UBOUND(ModuleMapTypeData%u_BD_RootMotion,1) + CALL MeshDestroy( ModuleMapTypeData%u_BD_RootMotion(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(ModuleMapTypeData%u_BD_RootMotion) +ENDIF +IF (ALLOCATED(ModuleMapTypeData%y_BD_BldMotion_4Loads)) THEN +DO i1 = LBOUND(ModuleMapTypeData%y_BD_BldMotion_4Loads,1), UBOUND(ModuleMapTypeData%y_BD_BldMotion_4Loads,1) + CALL MeshDestroy( ModuleMapTypeData%y_BD_BldMotion_4Loads(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(ModuleMapTypeData%y_BD_BldMotion_4Loads) +ENDIF + CALL MeshDestroy( ModuleMapTypeData%u_Orca_PtfmMesh, ErrStat, ErrMsg ) + CALL MeshDestroy( ModuleMapTypeData%u_ExtPtfm_PtfmMesh, ErrStat, ErrMsg ) + END SUBROUTINE FAST_DestroyModuleMapType + + SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(FAST_ModuleMapType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackModuleMapType' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Int_BufSz = Int_BufSz + 1 ! ED_P_2_BD_P allocated yes/no + IF ( ALLOCATED(InData%ED_P_2_BD_P) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! ED_P_2_BD_P upper/lower bounds for each dimension + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + DO i1 = LBOUND(InData%ED_P_2_BD_P,1), UBOUND(InData%ED_P_2_BD_P,1) + Int_BufSz = Int_BufSz + 3 ! ED_P_2_BD_P: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_BD_P(i1), ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_BD_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_BD_P + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_BD_P + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_BD_P + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! BD_P_2_ED_P allocated yes/no + IF ( ALLOCATED(InData%BD_P_2_ED_P) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! BD_P_2_ED_P upper/lower bounds for each dimension + DO i1 = LBOUND(InData%BD_P_2_ED_P,1), UBOUND(InData%BD_P_2_ED_P,1) + Int_BufSz = Int_BufSz + 3 ! BD_P_2_ED_P: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%BD_P_2_ED_P(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BD_P_2_ED_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! BD_P_2_ED_P + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! BD_P_2_ED_P + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! BD_P_2_ED_P + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! ED_P_2_BD_P_Hub allocated yes/no + IF ( ALLOCATED(InData%ED_P_2_BD_P_Hub) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! ED_P_2_BD_P_Hub upper/lower bounds for each dimension + DO i1 = LBOUND(InData%ED_P_2_BD_P_Hub,1), UBOUND(InData%ED_P_2_BD_P_Hub,1) + Int_BufSz = Int_BufSz + 3 ! ED_P_2_BD_P_Hub: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_BD_P_Hub(i1), ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_BD_P_Hub + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_BD_P_Hub + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_BD_P_Hub + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_BD_P_Hub + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 3 ! ED_P_2_HD_W_P: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_HD_W_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_HD_W_P + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_HD_W_P + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_HD_W_P + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! HD_W_P_2_ED_P: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%HD_W_P_2_ED_P, ErrStat2, ErrMsg2, .TRUE. ) ! HD_W_P_2_ED_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! HD_W_P_2_ED_P + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! HD_W_P_2_ED_P + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! HD_W_P_2_ED_P + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! ED_P_2_HD_M_P: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_HD_M_P, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_HD_M_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_HD_M_P + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_HD_M_P + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_HD_M_P + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! HD_M_P_2_ED_P: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%HD_M_P_2_ED_P, ErrStat2, ErrMsg2, .TRUE. ) ! HD_M_P_2_ED_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! HD_M_P_2_ED_P + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! HD_M_P_2_ED_P + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! HD_M_P_2_ED_P + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! ED_P_2_HD_M_L: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_HD_M_L, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_HD_M_L + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_HD_M_L + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_HD_M_L + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_HD_M_L + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! HD_M_L_2_ED_P: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%HD_M_L_2_ED_P, ErrStat2, ErrMsg2, .TRUE. ) ! HD_M_L_2_ED_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! HD_M_L_2_ED_P + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! HD_M_L_2_ED_P + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! HD_M_L_2_ED_P + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! ED_P_2_Mooring_P: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_Mooring_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_Mooring_P + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_Mooring_P + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_Mooring_P + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! Mooring_P_2_ED_P: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, .TRUE. ) ! Mooring_P_2_ED_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Mooring_P_2_ED_P + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Mooring_P_2_ED_P + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Mooring_P_2_ED_P + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! ED_P_2_SD_TP: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_SD_TP, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_SD_TP + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_SD_TP + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_SD_TP + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_SD_TP + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! SD_TP_2_ED_P: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SD_TP_2_ED_P, ErrStat2, ErrMsg2, .TRUE. ) ! SD_TP_2_ED_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! SD_TP_2_ED_P + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! SD_TP_2_ED_P + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! SD_TP_2_ED_P + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! SD_P_2_HD_M_P: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SD_P_2_HD_M_P, ErrStat2, ErrMsg2, .TRUE. ) ! SD_P_2_HD_M_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! SD_P_2_HD_M_P + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! SD_P_2_HD_M_P + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! SD_P_2_HD_M_P + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! HD_M_P_2_SD_P: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%HD_M_P_2_SD_P, ErrStat2, ErrMsg2, .TRUE. ) ! HD_M_P_2_SD_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! HD_M_P_2_SD_P + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! HD_M_P_2_SD_P + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! HD_M_P_2_SD_P + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! SD_P_2_HD_M_L: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SD_P_2_HD_M_L, ErrStat2, ErrMsg2, .TRUE. ) ! SD_P_2_HD_M_L + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! SD_P_2_HD_M_L + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! SD_P_2_HD_M_L + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! SD_P_2_HD_M_L + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! HD_M_L_2_SD_P: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%HD_M_L_2_SD_P, ErrStat2, ErrMsg2, .TRUE. ) ! HD_M_L_2_SD_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! HD_M_L_2_SD_P + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! HD_M_L_2_SD_P + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! HD_M_L_2_SD_P + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! ED_P_2_SrvD_P_N: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_SrvD_P_N, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_SrvD_P_N + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_SrvD_P_N + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_SrvD_P_N + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_SrvD_P_N + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! SrvD_P_2_ED_P_N: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SrvD_P_2_ED_P_N, ErrStat2, ErrMsg2, .TRUE. ) ! SrvD_P_2_ED_P_N + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! SrvD_P_2_ED_P_N + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! SrvD_P_2_ED_P_N + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! SrvD_P_2_ED_P_N + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! ED_L_2_SrvD_P_T: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_L_2_SrvD_P_T, ErrStat2, ErrMsg2, .TRUE. ) ! ED_L_2_SrvD_P_T + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! ED_L_2_SrvD_P_T + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! ED_L_2_SrvD_P_T + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! ED_L_2_SrvD_P_T + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! SrvD_P_2_ED_P_T: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SrvD_P_2_ED_P_T, ErrStat2, ErrMsg2, .TRUE. ) ! SrvD_P_2_ED_P_T + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! SrvD_P_2_ED_P_T + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! SrvD_P_2_ED_P_T + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! SrvD_P_2_ED_P_T + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! BDED_L_2_AD_L_B allocated yes/no + IF ( ALLOCATED(InData%BDED_L_2_AD_L_B) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! BDED_L_2_AD_L_B upper/lower bounds for each dimension + DO i1 = LBOUND(InData%BDED_L_2_AD_L_B,1), UBOUND(InData%BDED_L_2_AD_L_B,1) + Int_BufSz = Int_BufSz + 3 ! BDED_L_2_AD_L_B: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%BDED_L_2_AD_L_B(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BDED_L_2_AD_L_B + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! BDED_L_2_AD_L_B + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! BDED_L_2_AD_L_B + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! BDED_L_2_AD_L_B + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! AD_L_2_BDED_B allocated yes/no + IF ( ALLOCATED(InData%AD_L_2_BDED_B) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! AD_L_2_BDED_B upper/lower bounds for each dimension + DO i1 = LBOUND(InData%AD_L_2_BDED_B,1), UBOUND(InData%AD_L_2_BDED_B,1) + Int_BufSz = Int_BufSz + 3 ! AD_L_2_BDED_B: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_L_2_BDED_B(i1), ErrStat2, ErrMsg2, .TRUE. ) ! AD_L_2_BDED_B + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! AD_L_2_BDED_B + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! AD_L_2_BDED_B + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! AD_L_2_BDED_B + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! BD_L_2_BD_L allocated yes/no + IF ( ALLOCATED(InData%BD_L_2_BD_L) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! BD_L_2_BD_L upper/lower bounds for each dimension + DO i1 = LBOUND(InData%BD_L_2_BD_L,1), UBOUND(InData%BD_L_2_BD_L,1) + Int_BufSz = Int_BufSz + 3 ! BD_L_2_BD_L: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%BD_L_2_BD_L(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BD_L_2_BD_L + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! BD_L_2_BD_L + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! BD_L_2_BD_L + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! BD_L_2_BD_L + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 3 ! ED_L_2_AD_L_T: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_L_2_AD_L_T, ErrStat2, ErrMsg2, .TRUE. ) ! ED_L_2_AD_L_T + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! ED_L_2_AD_L_T + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! ED_L_2_AD_L_T + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! ED_L_2_AD_L_T + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! AD_L_2_ED_P_T: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_L_2_ED_P_T, ErrStat2, ErrMsg2, .TRUE. ) ! AD_L_2_ED_P_T + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! AD_L_2_ED_P_T + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! AD_L_2_ED_P_T + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! AD_L_2_ED_P_T + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! ED_P_2_AD_P_R allocated yes/no + IF ( ALLOCATED(InData%ED_P_2_AD_P_R) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! ED_P_2_AD_P_R upper/lower bounds for each dimension + DO i1 = LBOUND(InData%ED_P_2_AD_P_R,1), UBOUND(InData%ED_P_2_AD_P_R,1) + Int_BufSz = Int_BufSz + 3 ! ED_P_2_AD_P_R: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_R(i1), ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_AD_P_R + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_AD_P_R + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_AD_P_R + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_AD_P_R + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 3 ! ED_P_2_AD_P_H: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_AD_P_H + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_AD_P_H + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_AD_P_H + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_AD_P_H + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! IceF_P_2_SD_P: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%IceF_P_2_SD_P, ErrStat2, ErrMsg2, .TRUE. ) ! IceF_P_2_SD_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! IceF_P_2_SD_P + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! IceF_P_2_SD_P + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! IceF_P_2_SD_P + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! SD_P_2_IceF_P: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SD_P_2_IceF_P, ErrStat2, ErrMsg2, .TRUE. ) ! SD_P_2_IceF_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! SD_P_2_IceF_P + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! SD_P_2_IceF_P + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! SD_P_2_IceF_P + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! IceD_P_2_SD_P allocated yes/no + IF ( ALLOCATED(InData%IceD_P_2_SD_P) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! IceD_P_2_SD_P upper/lower bounds for each dimension + DO i1 = LBOUND(InData%IceD_P_2_SD_P,1), UBOUND(InData%IceD_P_2_SD_P,1) + Int_BufSz = Int_BufSz + 3 ! IceD_P_2_SD_P: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%IceD_P_2_SD_P(i1), ErrStat2, ErrMsg2, .TRUE. ) ! IceD_P_2_SD_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! IceD_P_2_SD_P + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! IceD_P_2_SD_P + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! IceD_P_2_SD_P + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! SD_P_2_IceD_P allocated yes/no + IF ( ALLOCATED(InData%SD_P_2_IceD_P) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! SD_P_2_IceD_P upper/lower bounds for each dimension + DO i1 = LBOUND(InData%SD_P_2_IceD_P,1), UBOUND(InData%SD_P_2_IceD_P,1) + Int_BufSz = Int_BufSz + 3 ! SD_P_2_IceD_P: size of buffers for each call to pack subtype + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SD_P_2_IceD_P(i1), ErrStat2, ErrMsg2, .TRUE. ) ! SD_P_2_IceD_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! SD_P_2_IceD_P + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! SD_P_2_IceD_P + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! SD_P_2_IceD_P + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! Jacobian_Opt1 allocated yes/no + IF ( ALLOCATED(InData%Jacobian_Opt1) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! Jacobian_Opt1 upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%Jacobian_Opt1) ! Jacobian_Opt1 + END IF + Int_BufSz = Int_BufSz + 1 ! Jacobian_pivot allocated yes/no + IF ( ALLOCATED(InData%Jacobian_pivot) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! Jacobian_pivot upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%Jacobian_pivot) ! Jacobian_pivot + END IF + Int_BufSz = Int_BufSz + 1 ! Jac_u_indx allocated yes/no + IF ( ALLOCATED(InData%Jac_u_indx) ) THEN + Int_BufSz = Int_BufSz + 2*2 ! Jac_u_indx upper/lower bounds for each dimension + Int_BufSz = Int_BufSz + SIZE(InData%Jac_u_indx) ! Jac_u_indx + END IF + Int_BufSz = Int_BufSz + 3 ! u_ED_PlatformPtMesh: size of buffers for each call to pack subtype + CALL MeshPack( InData%u_ED_PlatformPtMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_ED_PlatformPtMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u_ED_PlatformPtMesh + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u_ED_PlatformPtMesh + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u_ED_PlatformPtMesh + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! u_ED_PlatformPtMesh_2: size of buffers for each call to pack subtype + CALL MeshPack( InData%u_ED_PlatformPtMesh_2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_ED_PlatformPtMesh_2 + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u_ED_PlatformPtMesh_2 + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u_ED_PlatformPtMesh_2 + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u_ED_PlatformPtMesh_2 + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! u_SD_TPMesh: size of buffers for each call to pack subtype + CALL MeshPack( InData%u_SD_TPMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_SD_TPMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u_SD_TPMesh + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u_SD_TPMesh + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u_SD_TPMesh + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! u_SD_LMesh: size of buffers for each call to pack subtype + CALL MeshPack( InData%u_SD_LMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_SD_LMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u_SD_LMesh + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u_SD_LMesh + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u_SD_LMesh + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! u_SD_LMesh_2: size of buffers for each call to pack subtype + CALL MeshPack( InData%u_SD_LMesh_2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_SD_LMesh_2 + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u_SD_LMesh_2 + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u_SD_LMesh_2 + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u_SD_LMesh_2 + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! u_HD_M_LumpedMesh: size of buffers for each call to pack subtype + CALL MeshPack( InData%u_HD_M_LumpedMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_HD_M_LumpedMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u_HD_M_LumpedMesh + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u_HD_M_LumpedMesh + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u_HD_M_LumpedMesh + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! u_HD_M_DistribMesh: size of buffers for each call to pack subtype + CALL MeshPack( InData%u_HD_M_DistribMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_HD_M_DistribMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u_HD_M_DistribMesh + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u_HD_M_DistribMesh + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u_HD_M_DistribMesh + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! u_HD_Mesh: size of buffers for each call to pack subtype + CALL MeshPack( InData%u_HD_Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_HD_Mesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u_HD_Mesh + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u_HD_Mesh + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u_HD_Mesh + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! u_ED_HubPtLoad: size of buffers for each call to pack subtype + CALL MeshPack( InData%u_ED_HubPtLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_ED_HubPtLoad + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u_ED_HubPtLoad + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u_ED_HubPtLoad + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u_ED_HubPtLoad + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! u_ED_HubPtLoad_2: size of buffers for each call to pack subtype + CALL MeshPack( InData%u_ED_HubPtLoad_2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_ED_HubPtLoad_2 + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u_ED_HubPtLoad_2 + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u_ED_HubPtLoad_2 + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u_ED_HubPtLoad_2 + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 1 ! u_BD_RootMotion allocated yes/no + IF ( ALLOCATED(InData%u_BD_RootMotion) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! u_BD_RootMotion upper/lower bounds for each dimension + DO i1 = LBOUND(InData%u_BD_RootMotion,1), UBOUND(InData%u_BD_RootMotion,1) + Int_BufSz = Int_BufSz + 3 ! u_BD_RootMotion: size of buffers for each call to pack subtype + CALL MeshPack( InData%u_BD_RootMotion(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_BD_RootMotion + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u_BD_RootMotion + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u_BD_RootMotion + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u_BD_RootMotion + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! y_BD_BldMotion_4Loads allocated yes/no + IF ( ALLOCATED(InData%y_BD_BldMotion_4Loads) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! y_BD_BldMotion_4Loads upper/lower bounds for each dimension + DO i1 = LBOUND(InData%y_BD_BldMotion_4Loads,1), UBOUND(InData%y_BD_BldMotion_4Loads,1) + Int_BufSz = Int_BufSz + 3 ! y_BD_BldMotion_4Loads: size of buffers for each call to pack subtype + CALL MeshPack( InData%y_BD_BldMotion_4Loads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! y_BD_BldMotion_4Loads + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! y_BD_BldMotion_4Loads + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! y_BD_BldMotion_4Loads + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! y_BD_BldMotion_4Loads + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 3 ! u_Orca_PtfmMesh: size of buffers for each call to pack subtype + CALL MeshPack( InData%u_Orca_PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_Orca_PtfmMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u_Orca_PtfmMesh + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u_Orca_PtfmMesh + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u_Orca_PtfmMesh + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! u_ExtPtfm_PtfmMesh: size of buffers for each call to pack subtype + CALL MeshPack( InData%u_ExtPtfm_PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_ExtPtfm_PtfmMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! u_ExtPtfm_PtfmMesh + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! u_ExtPtfm_PtfmMesh + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! u_ExtPtfm_PtfmMesh + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + IF ( .NOT. ALLOCATED(InData%ED_P_2_BD_P) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%ED_P_2_BD_P,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ED_P_2_BD_P,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%ED_P_2_BD_P,1), UBOUND(InData%ED_P_2_BD_P,1) + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_BD_P(i1), ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_BD_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%BD_P_2_ED_P) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BD_P_2_ED_P,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BD_P_2_ED_P,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%BD_P_2_ED_P,1), UBOUND(InData%BD_P_2_ED_P,1) + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%BD_P_2_ED_P(i1), ErrStat2, ErrMsg2, OnlySize ) ! BD_P_2_ED_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%ED_P_2_BD_P_Hub) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%ED_P_2_BD_P_Hub,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ED_P_2_BD_P_Hub,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%ED_P_2_BD_P_Hub,1), UBOUND(InData%ED_P_2_BD_P_Hub,1) + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_BD_P_Hub(i1), ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_BD_P_Hub + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_HD_W_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%HD_W_P_2_ED_P, ErrStat2, ErrMsg2, OnlySize ) ! HD_W_P_2_ED_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_HD_M_P, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_HD_M_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%HD_M_P_2_ED_P, ErrStat2, ErrMsg2, OnlySize ) ! HD_M_P_2_ED_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_HD_M_L, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_HD_M_L + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%HD_M_L_2_ED_P, ErrStat2, ErrMsg2, OnlySize ) ! HD_M_L_2_ED_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_Mooring_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, OnlySize ) ! Mooring_P_2_ED_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_SD_TP, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_SD_TP + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SD_TP_2_ED_P, ErrStat2, ErrMsg2, OnlySize ) ! SD_TP_2_ED_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SD_P_2_HD_M_P, ErrStat2, ErrMsg2, OnlySize ) ! SD_P_2_HD_M_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%HD_M_P_2_SD_P, ErrStat2, ErrMsg2, OnlySize ) ! HD_M_P_2_SD_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SD_P_2_HD_M_L, ErrStat2, ErrMsg2, OnlySize ) ! SD_P_2_HD_M_L + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%HD_M_L_2_SD_P, ErrStat2, ErrMsg2, OnlySize ) ! HD_M_L_2_SD_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_SrvD_P_N, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_SrvD_P_N + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SrvD_P_2_ED_P_N, ErrStat2, ErrMsg2, OnlySize ) ! SrvD_P_2_ED_P_N + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_L_2_SrvD_P_T, ErrStat2, ErrMsg2, OnlySize ) ! ED_L_2_SrvD_P_T + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SrvD_P_2_ED_P_T, ErrStat2, ErrMsg2, OnlySize ) ! SrvD_P_2_ED_P_T + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%BDED_L_2_AD_L_B) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BDED_L_2_AD_L_B,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BDED_L_2_AD_L_B,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%BDED_L_2_AD_L_B,1), UBOUND(InData%BDED_L_2_AD_L_B,1) + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%BDED_L_2_AD_L_B(i1), ErrStat2, ErrMsg2, OnlySize ) ! BDED_L_2_AD_L_B + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%AD_L_2_BDED_B) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%AD_L_2_BDED_B,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AD_L_2_BDED_B,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%AD_L_2_BDED_B,1), UBOUND(InData%AD_L_2_BDED_B,1) + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_L_2_BDED_B(i1), ErrStat2, ErrMsg2, OnlySize ) ! AD_L_2_BDED_B + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%BD_L_2_BD_L) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BD_L_2_BD_L,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BD_L_2_BD_L,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%BD_L_2_BD_L,1), UBOUND(InData%BD_L_2_BD_L,1) + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%BD_L_2_BD_L(i1), ErrStat2, ErrMsg2, OnlySize ) ! BD_L_2_BD_L + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_L_2_AD_L_T, ErrStat2, ErrMsg2, OnlySize ) ! ED_L_2_AD_L_T + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_L_2_ED_P_T, ErrStat2, ErrMsg2, OnlySize ) ! AD_L_2_ED_P_T + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%ED_P_2_AD_P_R) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%ED_P_2_AD_P_R,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ED_P_2_AD_P_R,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%ED_P_2_AD_P_R,1), UBOUND(InData%ED_P_2_AD_P_R,1) + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_R(i1), ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_AD_P_R + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_AD_P_H + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%IceF_P_2_SD_P, ErrStat2, ErrMsg2, OnlySize ) ! IceF_P_2_SD_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SD_P_2_IceF_P, ErrStat2, ErrMsg2, OnlySize ) ! SD_P_2_IceF_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%IceD_P_2_SD_P) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%IceD_P_2_SD_P,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IceD_P_2_SD_P,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%IceD_P_2_SD_P,1), UBOUND(InData%IceD_P_2_SD_P,1) + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%IceD_P_2_SD_P(i1), ErrStat2, ErrMsg2, OnlySize ) ! IceD_P_2_SD_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%SD_P_2_IceD_P) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%SD_P_2_IceD_P,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SD_P_2_IceD_P,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%SD_P_2_IceD_P,1), UBOUND(InData%SD_P_2_IceD_P,1) + CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SD_P_2_IceD_P(i1), ErrStat2, ErrMsg2, OnlySize ) ! SD_P_2_IceD_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Jacobian_Opt1) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Jacobian_Opt1,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jacobian_Opt1,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Jacobian_Opt1,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jacobian_Opt1,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%Jacobian_Opt1,2), UBOUND(InData%Jacobian_Opt1,2) + DO i1 = LBOUND(InData%Jacobian_Opt1,1), UBOUND(InData%Jacobian_Opt1,1) + ReKiBuf(Re_Xferred) = InData%Jacobian_Opt1(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Jacobian_pivot) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Jacobian_pivot,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jacobian_pivot,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%Jacobian_pivot,1), UBOUND(InData%Jacobian_pivot,1) + IntKiBuf(Int_Xferred) = InData%Jacobian_pivot(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%Jac_u_indx) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_u_indx,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,1) + Int_Xferred = Int_Xferred + 2 + IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_u_indx,2) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,2) + Int_Xferred = Int_Xferred + 2 + + DO i2 = LBOUND(InData%Jac_u_indx,2), UBOUND(InData%Jac_u_indx,2) + DO i1 = LBOUND(InData%Jac_u_indx,1), UBOUND(InData%Jac_u_indx,1) + IntKiBuf(Int_Xferred) = InData%Jac_u_indx(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + CALL MeshPack( InData%u_ED_PlatformPtMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_ED_PlatformPtMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL MeshPack( InData%u_ED_PlatformPtMesh_2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_ED_PlatformPtMesh_2 + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL MeshPack( InData%u_SD_TPMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_SD_TPMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL MeshPack( InData%u_SD_LMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_SD_LMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL MeshPack( InData%u_SD_LMesh_2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_SD_LMesh_2 + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL MeshPack( InData%u_HD_M_LumpedMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_HD_M_LumpedMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL MeshPack( InData%u_HD_M_DistribMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_HD_M_DistribMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL MeshPack( InData%u_HD_Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_HD_Mesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL MeshPack( InData%u_ED_HubPtLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_ED_HubPtLoad + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL MeshPack( InData%u_ED_HubPtLoad_2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_ED_HubPtLoad_2 + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF ( .NOT. ALLOCATED(InData%u_BD_RootMotion) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%u_BD_RootMotion,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_BD_RootMotion,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%u_BD_RootMotion,1), UBOUND(InData%u_BD_RootMotion,1) + CALL MeshPack( InData%u_BD_RootMotion(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_BD_RootMotion + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%y_BD_BldMotion_4Loads) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%y_BD_BldMotion_4Loads,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y_BD_BldMotion_4Loads,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%y_BD_BldMotion_4Loads,1), UBOUND(InData%y_BD_BldMotion_4Loads,1) + CALL MeshPack( InData%y_BD_BldMotion_4Loads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! y_BD_BldMotion_4Loads + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + CALL MeshPack( InData%u_Orca_PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_Orca_PtfmMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL MeshPack( InData%u_ExtPtfm_PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_ExtPtfm_PtfmMesh + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END SUBROUTINE FAST_PackModuleMapType + + SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(FAST_ModuleMapType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackModuleMapType' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ED_P_2_BD_P not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%ED_P_2_BD_P)) DEALLOCATE(OutData%ED_P_2_BD_P) + ALLOCATE(OutData%ED_P_2_BD_P(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_P_2_BD_P.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%ED_P_2_BD_P,1), UBOUND(OutData%ED_P_2_BD_P,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_BD_P(i1), ErrStat2, ErrMsg2 ) ! ED_P_2_BD_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BD_P_2_ED_P not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BD_P_2_ED_P)) DEALLOCATE(OutData%BD_P_2_ED_P) + ALLOCATE(OutData%BD_P_2_ED_P(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BD_P_2_ED_P.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%BD_P_2_ED_P,1), UBOUND(OutData%BD_P_2_ED_P,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%BD_P_2_ED_P(i1), ErrStat2, ErrMsg2 ) ! BD_P_2_ED_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ED_P_2_BD_P_Hub not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%ED_P_2_BD_P_Hub)) DEALLOCATE(OutData%ED_P_2_BD_P_Hub) + ALLOCATE(OutData%ED_P_2_BD_P_Hub(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_P_2_BD_P_Hub.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%ED_P_2_BD_P_Hub,1), UBOUND(OutData%ED_P_2_BD_P_Hub,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_BD_P_Hub(i1), ErrStat2, ErrMsg2 ) ! ED_P_2_BD_P_Hub + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2 ) ! ED_P_2_HD_W_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%HD_W_P_2_ED_P, ErrStat2, ErrMsg2 ) ! HD_W_P_2_ED_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_HD_M_P, ErrStat2, ErrMsg2 ) ! ED_P_2_HD_M_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%HD_M_P_2_ED_P, ErrStat2, ErrMsg2 ) ! HD_M_P_2_ED_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_HD_M_L, ErrStat2, ErrMsg2 ) ! ED_P_2_HD_M_L + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%HD_M_L_2_ED_P, ErrStat2, ErrMsg2 ) ! HD_M_L_2_ED_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) ! ED_P_2_Mooring_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2 ) ! Mooring_P_2_ED_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) ! ED_P_2_SD_TP + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%SD_TP_2_ED_P, ErrStat2, ErrMsg2 ) ! SD_TP_2_ED_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%SD_P_2_HD_M_P, ErrStat2, ErrMsg2 ) ! SD_P_2_HD_M_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%HD_M_P_2_SD_P, ErrStat2, ErrMsg2 ) ! HD_M_P_2_SD_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%SD_P_2_HD_M_L, ErrStat2, ErrMsg2 ) ! SD_P_2_HD_M_L + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%HD_M_L_2_SD_P, ErrStat2, ErrMsg2 ) ! HD_M_L_2_SD_P + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_SrvD_P_N, ErrStat2, ErrMsg2 ) ! ED_P_2_SrvD_P_N + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%SrvD_P_2_ED_P_N, ErrStat2, ErrMsg2 ) ! SrvD_P_2_ED_P_N + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_L_2_SrvD_P_T, ErrStat2, ErrMsg2 ) ! ED_L_2_SrvD_P_T + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%SrvD_P_2_ED_P_T, ErrStat2, ErrMsg2 ) ! SrvD_P_2_ED_P_T CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_BD_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BDED_L_2_AD_L_B not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BDED_L_2_AD_L_B)) DEALLOCATE(OutData%BDED_L_2_AD_L_B) + ALLOCATE(OutData%BDED_L_2_AD_L_B(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BDED_L_2_AD_L_B.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%BDED_L_2_AD_L_B,1), UBOUND(OutData%BDED_L_2_AD_L_B,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_BD_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_BD_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%BDED_L_2_AD_L_B(i1), ErrStat2, ErrMsg2 ) ! BDED_L_2_AD_L_B + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - Int_BufSz = Int_BufSz + 1 ! BD_P_2_ED_P allocated yes/no - IF ( ALLOCATED(InData%BD_P_2_ED_P) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BD_P_2_ED_P upper/lower bounds for each dimension - DO i1 = LBOUND(InData%BD_P_2_ED_P,1), UBOUND(InData%BD_P_2_ED_P,1) - Int_BufSz = Int_BufSz + 3 ! BD_P_2_ED_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%BD_P_2_ED_P(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BD_P_2_ED_P + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AD_L_2_BDED_B not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%AD_L_2_BDED_B)) DEALLOCATE(OutData%AD_L_2_BDED_B) + ALLOCATE(OutData%AD_L_2_BDED_B(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AD_L_2_BDED_B.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%AD_L_2_BDED_B,1), UBOUND(OutData%AD_L_2_BDED_B,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%AD_L_2_BDED_B(i1), ErrStat2, ErrMsg2 ) ! AD_L_2_BDED_B CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! BD_P_2_ED_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BD_L_2_BD_L not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BD_L_2_BD_L)) DEALLOCATE(OutData%BD_L_2_BD_L) + ALLOCATE(OutData%BD_L_2_BD_L(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BD_L_2_BD_L.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%BD_L_2_BD_L,1), UBOUND(OutData%BD_L_2_BD_L,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! BD_P_2_ED_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! BD_P_2_ED_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%BD_L_2_BD_L(i1), ErrStat2, ErrMsg2 ) ! BD_L_2_BD_L + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - Int_BufSz = Int_BufSz + 1 ! ED_P_2_BD_P_Hub allocated yes/no - IF ( ALLOCATED(InData%ED_P_2_BD_P_Hub) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ED_P_2_BD_P_Hub upper/lower bounds for each dimension - DO i1 = LBOUND(InData%ED_P_2_BD_P_Hub,1), UBOUND(InData%ED_P_2_BD_P_Hub,1) - Int_BufSz = Int_BufSz + 3 ! ED_P_2_BD_P_Hub: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_BD_P_Hub(i1), ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_BD_P_Hub + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_L_2_AD_L_T, ErrStat2, ErrMsg2 ) ! ED_L_2_AD_L_T CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_BD_P_Hub - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_BD_P_Hub - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_BD_P_Hub - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%AD_L_2_ED_P_T, ErrStat2, ErrMsg2 ) ! AD_L_2_ED_P_T + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ED_P_2_AD_P_R not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%ED_P_2_AD_P_R)) DEALLOCATE(OutData%ED_P_2_AD_P_R) + ALLOCATE(OutData%ED_P_2_AD_P_R(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_P_2_AD_P_R.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%ED_P_2_AD_P_R,1), UBOUND(OutData%ED_P_2_AD_P_R,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_AD_P_R(i1), ErrStat2, ErrMsg2 ) ! ED_P_2_AD_P_R + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - Int_BufSz = Int_BufSz + 3 ! ED_P_2_HD_W_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_HD_W_P + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2 ) ! ED_P_2_AD_P_H CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_HD_W_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_HD_W_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_HD_W_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - Int_BufSz = Int_BufSz + 3 ! HD_W_P_2_ED_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%HD_W_P_2_ED_P, ErrStat2, ErrMsg2, .TRUE. ) ! HD_W_P_2_ED_P + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%IceF_P_2_SD_P, ErrStat2, ErrMsg2 ) ! IceF_P_2_SD_P CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! HD_W_P_2_ED_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! HD_W_P_2_ED_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! HD_W_P_2_ED_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - Int_BufSz = Int_BufSz + 3 ! ED_P_2_HD_M_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_HD_M_P, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_HD_M_P + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%SD_P_2_IceF_P, ErrStat2, ErrMsg2 ) ! SD_P_2_IceF_P CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_HD_M_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_HD_M_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IceD_P_2_SD_P not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%IceD_P_2_SD_P)) DEALLOCATE(OutData%IceD_P_2_SD_P) + ALLOCATE(OutData%IceD_P_2_SD_P(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IceD_P_2_SD_P.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%IceD_P_2_SD_P,1), UBOUND(OutData%IceD_P_2_SD_P,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_HD_M_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - Int_BufSz = Int_BufSz + 3 ! HD_M_P_2_ED_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%HD_M_P_2_ED_P, ErrStat2, ErrMsg2, .TRUE. ) ! HD_M_P_2_ED_P + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%IceD_P_2_SD_P(i1), ErrStat2, ErrMsg2 ) ! IceD_P_2_SD_P CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! HD_M_P_2_ED_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SD_P_2_IceD_P not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%SD_P_2_IceD_P)) DEALLOCATE(OutData%SD_P_2_IceD_P) + ALLOCATE(OutData%SD_P_2_IceD_P(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SD_P_2_IceD_P.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%SD_P_2_IceD_P,1), UBOUND(OutData%SD_P_2_IceD_P,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! HD_M_P_2_ED_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! HD_M_P_2_ED_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - Int_BufSz = Int_BufSz + 3 ! ED_P_2_HD_M_L: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_HD_M_L, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_HD_M_L + CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%SD_P_2_IceD_P(i1), ErrStat2, ErrMsg2 ) ! SD_P_2_IceD_P CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_HD_M_L - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jacobian_Opt1 not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Jacobian_Opt1)) DEALLOCATE(OutData%Jacobian_Opt1) + ALLOCATE(OutData%Jacobian_Opt1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jacobian_Opt1.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%Jacobian_Opt1,2), UBOUND(OutData%Jacobian_Opt1,2) + DO i1 = LBOUND(OutData%Jacobian_Opt1,1), UBOUND(OutData%Jacobian_Opt1,1) + OutData%Jacobian_Opt1(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jacobian_pivot not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Jacobian_pivot)) DEALLOCATE(OutData%Jacobian_pivot) + ALLOCATE(OutData%Jacobian_pivot(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jacobian_pivot.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%Jacobian_pivot,1), UBOUND(OutData%Jacobian_pivot,1) + OutData%Jacobian_pivot(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_u_indx not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + i2_l = IntKiBuf( Int_Xferred ) + i2_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%Jac_u_indx)) DEALLOCATE(OutData%Jac_u_indx) + ALLOCATE(OutData%Jac_u_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i2 = LBOUND(OutData%Jac_u_indx,2), UBOUND(OutData%Jac_u_indx,2) + DO i1 = LBOUND(OutData%Jac_u_indx,1), UBOUND(OutData%Jac_u_indx,1) + OutData%Jac_u_indx(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_HD_M_L - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_HD_M_L - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - Int_BufSz = Int_BufSz + 3 ! HD_M_L_2_ED_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%HD_M_L_2_ED_P, ErrStat2, ErrMsg2, .TRUE. ) ! HD_M_L_2_ED_P + CALL MeshUnpack( OutData%u_ED_PlatformPtMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_ED_PlatformPtMesh CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! HD_M_L_2_ED_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! HD_M_L_2_ED_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! HD_M_L_2_ED_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - Int_BufSz = Int_BufSz + 3 ! ED_P_2_Mooring_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_Mooring_P + CALL MeshUnpack( OutData%u_ED_PlatformPtMesh_2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_ED_PlatformPtMesh_2 CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_Mooring_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_Mooring_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_Mooring_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - Int_BufSz = Int_BufSz + 3 ! Mooring_P_2_ED_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, .TRUE. ) ! Mooring_P_2_ED_P + CALL MeshUnpack( OutData%u_SD_TPMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_SD_TPMesh CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! Mooring_P_2_ED_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! Mooring_P_2_ED_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! Mooring_P_2_ED_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - Int_BufSz = Int_BufSz + 3 ! ED_P_2_SD_TP: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_SD_TP, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_SD_TP + CALL MeshUnpack( OutData%u_SD_LMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_SD_LMesh CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_SD_TP - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_SD_TP - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_SD_TP - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - Int_BufSz = Int_BufSz + 3 ! SD_TP_2_ED_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SD_TP_2_ED_P, ErrStat2, ErrMsg2, .TRUE. ) ! SD_TP_2_ED_P + CALL MeshUnpack( OutData%u_SD_LMesh_2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_SD_LMesh_2 CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! SD_TP_2_ED_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! SD_TP_2_ED_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! SD_TP_2_ED_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - Int_BufSz = Int_BufSz + 3 ! SD_P_2_HD_M_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SD_P_2_HD_M_P, ErrStat2, ErrMsg2, .TRUE. ) ! SD_P_2_HD_M_P + CALL MeshUnpack( OutData%u_HD_M_LumpedMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_HD_M_LumpedMesh CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! SD_P_2_HD_M_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! SD_P_2_HD_M_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! SD_P_2_HD_M_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - Int_BufSz = Int_BufSz + 3 ! HD_M_P_2_SD_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%HD_M_P_2_SD_P, ErrStat2, ErrMsg2, .TRUE. ) ! HD_M_P_2_SD_P + CALL MeshUnpack( OutData%u_HD_M_DistribMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_HD_M_DistribMesh CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! HD_M_P_2_SD_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! HD_M_P_2_SD_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! HD_M_P_2_SD_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - Int_BufSz = Int_BufSz + 3 ! SD_P_2_HD_M_L: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SD_P_2_HD_M_L, ErrStat2, ErrMsg2, .TRUE. ) ! SD_P_2_HD_M_L + CALL MeshUnpack( OutData%u_HD_Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_HD_Mesh CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! SD_P_2_HD_M_L - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! SD_P_2_HD_M_L - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! SD_P_2_HD_M_L - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - Int_BufSz = Int_BufSz + 3 ! HD_M_L_2_SD_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%HD_M_L_2_SD_P, ErrStat2, ErrMsg2, .TRUE. ) ! HD_M_L_2_SD_P + CALL MeshUnpack( OutData%u_ED_HubPtLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_ED_HubPtLoad CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! HD_M_L_2_SD_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! HD_M_L_2_SD_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! HD_M_L_2_SD_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - Int_BufSz = Int_BufSz + 3 ! ED_P_2_SrvD_P_N: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_SrvD_P_N, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_SrvD_P_N + CALL MeshUnpack( OutData%u_ED_HubPtLoad_2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_ED_HubPtLoad_2 CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_SrvD_P_N - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_BD_RootMotion not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%u_BD_RootMotion)) DEALLOCATE(OutData%u_BD_RootMotion) + ALLOCATE(OutData%u_BD_RootMotion(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_BD_RootMotion.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%u_BD_RootMotion,1), UBOUND(OutData%u_BD_RootMotion,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_SrvD_P_N - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_SrvD_P_N - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - Int_BufSz = Int_BufSz + 3 ! SrvD_P_2_ED_P_N: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SrvD_P_2_ED_P_N, ErrStat2, ErrMsg2, .TRUE. ) ! SrvD_P_2_ED_P_N + CALL MeshUnpack( OutData%u_BD_RootMotion(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_BD_RootMotion CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! SrvD_P_2_ED_P_N - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! y_BD_BldMotion_4Loads not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%y_BD_BldMotion_4Loads)) DEALLOCATE(OutData%y_BD_BldMotion_4Loads) + ALLOCATE(OutData%y_BD_BldMotion_4Loads(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_BD_BldMotion_4Loads.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%y_BD_BldMotion_4Loads,1), UBOUND(OutData%y_BD_BldMotion_4Loads,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! SrvD_P_2_ED_P_N - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! SrvD_P_2_ED_P_N - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - Int_BufSz = Int_BufSz + 3 ! ED_L_2_SrvD_P_T: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_L_2_SrvD_P_T, ErrStat2, ErrMsg2, .TRUE. ) ! ED_L_2_SrvD_P_T + CALL MeshUnpack( OutData%y_BD_BldMotion_4Loads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! y_BD_BldMotion_4Loads CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! ED_L_2_SrvD_P_T - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_L_2_SrvD_P_T - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_L_2_SrvD_P_T - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - Int_BufSz = Int_BufSz + 3 ! SrvD_P_2_ED_P_T: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SrvD_P_2_ED_P_T, ErrStat2, ErrMsg2, .TRUE. ) ! SrvD_P_2_ED_P_T + CALL MeshUnpack( OutData%u_Orca_PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_Orca_PtfmMesh CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! SrvD_P_2_ED_P_T - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size END IF - IF(ALLOCATED(Db_Buf)) THEN ! SrvD_P_2_ED_P_T - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size END IF - IF(ALLOCATED(Int_Buf)) THEN ! SrvD_P_2_ED_P_T - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size END IF - Int_BufSz = Int_BufSz + 1 ! BDED_L_2_AD_L_B allocated yes/no - IF ( ALLOCATED(InData%BDED_L_2_AD_L_B) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BDED_L_2_AD_L_B upper/lower bounds for each dimension - DO i1 = LBOUND(InData%BDED_L_2_AD_L_B,1), UBOUND(InData%BDED_L_2_AD_L_B,1) - Int_BufSz = Int_BufSz + 3 ! BDED_L_2_AD_L_B: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%BDED_L_2_AD_L_B(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BDED_L_2_AD_L_B + CALL MeshUnpack( OutData%u_ExtPtfm_PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_ExtPtfm_PtfmMesh CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! BDED_L_2_AD_L_B - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! BDED_L_2_AD_L_B - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! BDED_L_2_AD_L_B - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! AD_L_2_BDED_B allocated yes/no - IF ( ALLOCATED(InData%AD_L_2_BDED_B) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! AD_L_2_BDED_B upper/lower bounds for each dimension - DO i1 = LBOUND(InData%AD_L_2_BDED_B,1), UBOUND(InData%AD_L_2_BDED_B,1) - Int_BufSz = Int_BufSz + 3 ! AD_L_2_BDED_B: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_L_2_BDED_B(i1), ErrStat2, ErrMsg2, .TRUE. ) ! AD_L_2_BDED_B - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END SUBROUTINE FAST_UnPackModuleMapType + + SUBROUTINE FAST_CopyExternInputType( SrcExternInputTypeData, DstExternInputTypeData, CtrlCode, ErrStat, ErrMsg ) + TYPE(FAST_ExternInputType), INTENT(IN) :: SrcExternInputTypeData + TYPE(FAST_ExternInputType), INTENT(INOUT) :: DstExternInputTypeData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyExternInputType' +! + ErrStat = ErrID_None + ErrMsg = "" + DstExternInputTypeData%GenTrq = SrcExternInputTypeData%GenTrq + DstExternInputTypeData%ElecPwr = SrcExternInputTypeData%ElecPwr + DstExternInputTypeData%YawPosCom = SrcExternInputTypeData%YawPosCom + DstExternInputTypeData%YawRateCom = SrcExternInputTypeData%YawRateCom + DstExternInputTypeData%BlPitchCom = SrcExternInputTypeData%BlPitchCom + DstExternInputTypeData%HSSBrFrac = SrcExternInputTypeData%HSSBrFrac + DstExternInputTypeData%LidarFocus = SrcExternInputTypeData%LidarFocus + END SUBROUTINE FAST_CopyExternInputType + + SUBROUTINE FAST_DestroyExternInputType( ExternInputTypeData, ErrStat, ErrMsg ) + TYPE(FAST_ExternInputType), INTENT(INOUT) :: ExternInputTypeData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyExternInputType' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" + END SUBROUTINE FAST_DestroyExternInputType + + SUBROUTINE FAST_PackExternInputType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(FAST_ExternInputType), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackExternInputType' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + Re_BufSz = Re_BufSz + 1 ! GenTrq + Re_BufSz = Re_BufSz + 1 ! ElecPwr + Re_BufSz = Re_BufSz + 1 ! YawPosCom + Re_BufSz = Re_BufSz + 1 ! YawRateCom + Re_BufSz = Re_BufSz + SIZE(InData%BlPitchCom) ! BlPitchCom + Re_BufSz = Re_BufSz + 1 ! HSSBrFrac + Re_BufSz = Re_BufSz + SIZE(InData%LidarFocus) ! LidarFocus + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + ReKiBuf(Re_Xferred) = InData%GenTrq + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%ElecPwr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawPosCom + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawRateCom + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%BlPitchCom,1), UBOUND(InData%BlPitchCom,1) + ReKiBuf(Re_Xferred) = InData%BlPitchCom(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%HSSBrFrac + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%LidarFocus,1), UBOUND(InData%LidarFocus,1) + ReKiBuf(Re_Xferred) = InData%LidarFocus(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END SUBROUTINE FAST_PackExternInputType + + SUBROUTINE FAST_UnPackExternInputType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(FAST_ExternInputType), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackExternInputType' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + OutData%GenTrq = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%ElecPwr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawPosCom = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawRateCom = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + i1_l = LBOUND(OutData%BlPitchCom,1) + i1_u = UBOUND(OutData%BlPitchCom,1) + DO i1 = LBOUND(OutData%BlPitchCom,1), UBOUND(OutData%BlPitchCom,1) + OutData%BlPitchCom(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%HSSBrFrac = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + i1_l = LBOUND(OutData%LidarFocus,1) + i1_u = UBOUND(OutData%LidarFocus,1) + DO i1 = LBOUND(OutData%LidarFocus,1), UBOUND(OutData%LidarFocus,1) + OutData%LidarFocus(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END SUBROUTINE FAST_UnPackExternInputType + + SUBROUTINE FAST_CopyInitData( SrcInitDataData, DstInitDataData, CtrlCode, ErrStat, ErrMsg ) + TYPE(FAST_InitData), INTENT(INOUT) :: SrcInitDataData + TYPE(FAST_InitData), INTENT(INOUT) :: DstInitDataData + INTEGER(IntKi), INTENT(IN ) :: CtrlCode + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg +! Local + INTEGER(IntKi) :: i,j,k + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyInitData' +! + ErrStat = ErrID_None + ErrMsg = "" + CALL ED_CopyInitInput( SrcInitDataData%InData_ED, DstInitDataData%InData_ED, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL ED_CopyInitOutput( SrcInitDataData%OutData_ED, DstInitDataData%OutData_ED, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL BD_CopyInitInput( SrcInitDataData%InData_BD, DstInitDataData%InData_BD, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN +IF (ALLOCATED(SrcInitDataData%OutData_BD)) THEN + i1_l = LBOUND(SrcInitDataData%OutData_BD,1) + i1_u = UBOUND(SrcInitDataData%OutData_BD,1) + IF (.NOT. ALLOCATED(DstInitDataData%OutData_BD)) THEN + ALLOCATE(DstInitDataData%OutData_BD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstInitDataData%OutData_BD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcInitDataData%OutData_BD,1), UBOUND(SrcInitDataData%OutData_BD,1) + CALL BD_CopyInitOutput( SrcInitDataData%OutData_BD(i1), DstInitDataData%OutData_BD(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF + CALL SrvD_CopyInitInput( SrcInitDataData%InData_SrvD, DstInitDataData%InData_SrvD, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL SrvD_CopyInitOutput( SrcInitDataData%OutData_SrvD, DstInitDataData%OutData_SrvD, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL AD14_CopyInitInput( SrcInitDataData%InData_AD14, DstInitDataData%InData_AD14, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL AD14_CopyInitOutput( SrcInitDataData%OutData_AD14, DstInitDataData%OutData_AD14, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL AD_CopyInitInput( SrcInitDataData%InData_AD, DstInitDataData%InData_AD, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL AD_CopyInitOutput( SrcInitDataData%OutData_AD, DstInitDataData%OutData_AD, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL InflowWind_CopyInitInput( SrcInitDataData%InData_IfW, DstInitDataData%InData_IfW, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL InflowWind_CopyInitOutput( SrcInitDataData%OutData_IfW, DstInitDataData%OutData_IfW, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL OpFM_CopyInitInput( SrcInitDataData%InData_OpFM, DstInitDataData%InData_OpFM, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL OpFM_CopyInitOutput( SrcInitDataData%OutData_OpFM, DstInitDataData%OutData_OpFM, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL HydroDyn_CopyInitInput( SrcInitDataData%InData_HD, DstInitDataData%InData_HD, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL HydroDyn_CopyInitOutput( SrcInitDataData%OutData_HD, DstInitDataData%OutData_HD, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL SD_CopyInitInput( SrcInitDataData%InData_SD, DstInitDataData%InData_SD, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL SD_CopyInitOutput( SrcInitDataData%OutData_SD, DstInitDataData%OutData_SD, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL ExtPtfm_CopyInitInput( SrcInitDataData%InData_ExtPtfm, DstInitDataData%InData_ExtPtfm, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL ExtPtfm_CopyInitOutput( SrcInitDataData%OutData_ExtPtfm, DstInitDataData%OutData_ExtPtfm, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MAP_CopyInitInput( SrcInitDataData%InData_MAP, DstInitDataData%InData_MAP, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MAP_CopyInitOutput( SrcInitDataData%OutData_MAP, DstInitDataData%OutData_MAP, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL FEAM_CopyInitInput( SrcInitDataData%InData_FEAM, DstInitDataData%InData_FEAM, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL FEAM_CopyInitOutput( SrcInitDataData%OutData_FEAM, DstInitDataData%OutData_FEAM, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MD_CopyInitInput( SrcInitDataData%InData_MD, DstInitDataData%InData_MD, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL MD_CopyInitOutput( SrcInitDataData%OutData_MD, DstInitDataData%OutData_MD, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL Orca_CopyInitInput( SrcInitDataData%InData_Orca, DstInitDataData%InData_Orca, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL Orca_CopyInitOutput( SrcInitDataData%OutData_Orca, DstInitDataData%OutData_Orca, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL IceFloe_CopyInitInput( SrcInitDataData%InData_IceF, DstInitDataData%InData_IceF, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL IceFloe_CopyInitOutput( SrcInitDataData%OutData_IceF, DstInitDataData%OutData_IceF, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL IceD_CopyInitInput( SrcInitDataData%InData_IceD, DstInitDataData%InData_IceD, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL IceD_CopyInitOutput( SrcInitDataData%OutData_IceD, DstInitDataData%OutData_IceD, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL SC_CopyInitInput( SrcInitDataData%InData_SC, DstInitDataData%InData_SC, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL SC_CopyInitOutput( SrcInitDataData%OutData_SC, DstInitDataData%OutData_SC, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + END SUBROUTINE FAST_CopyInitData + + SUBROUTINE FAST_DestroyInitData( InitDataData, ErrStat, ErrMsg ) + TYPE(FAST_InitData), INTENT(INOUT) :: InitDataData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyInitData' + INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 +! + ErrStat = ErrID_None + ErrMsg = "" + CALL ED_DestroyInitInput( InitDataData%InData_ED, ErrStat, ErrMsg ) + CALL ED_DestroyInitOutput( InitDataData%OutData_ED, ErrStat, ErrMsg ) + CALL BD_DestroyInitInput( InitDataData%InData_BD, ErrStat, ErrMsg ) +IF (ALLOCATED(InitDataData%OutData_BD)) THEN +DO i1 = LBOUND(InitDataData%OutData_BD,1), UBOUND(InitDataData%OutData_BD,1) + CALL BD_DestroyInitOutput( InitDataData%OutData_BD(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(InitDataData%OutData_BD) +ENDIF + CALL SrvD_DestroyInitInput( InitDataData%InData_SrvD, ErrStat, ErrMsg ) + CALL SrvD_DestroyInitOutput( InitDataData%OutData_SrvD, ErrStat, ErrMsg ) + CALL AD14_DestroyInitInput( InitDataData%InData_AD14, ErrStat, ErrMsg ) + CALL AD14_DestroyInitOutput( InitDataData%OutData_AD14, ErrStat, ErrMsg ) + CALL AD_DestroyInitInput( InitDataData%InData_AD, ErrStat, ErrMsg ) + CALL AD_DestroyInitOutput( InitDataData%OutData_AD, ErrStat, ErrMsg ) + CALL InflowWind_DestroyInitInput( InitDataData%InData_IfW, ErrStat, ErrMsg ) + CALL InflowWind_DestroyInitOutput( InitDataData%OutData_IfW, ErrStat, ErrMsg ) + CALL OpFM_DestroyInitInput( InitDataData%InData_OpFM, ErrStat, ErrMsg ) + CALL OpFM_DestroyInitOutput( InitDataData%OutData_OpFM, ErrStat, ErrMsg ) + CALL HydroDyn_DestroyInitInput( InitDataData%InData_HD, ErrStat, ErrMsg ) + CALL HydroDyn_DestroyInitOutput( InitDataData%OutData_HD, ErrStat, ErrMsg ) + CALL SD_DestroyInitInput( InitDataData%InData_SD, ErrStat, ErrMsg ) + CALL SD_DestroyInitOutput( InitDataData%OutData_SD, ErrStat, ErrMsg ) + CALL ExtPtfm_DestroyInitInput( InitDataData%InData_ExtPtfm, ErrStat, ErrMsg ) + CALL ExtPtfm_DestroyInitOutput( InitDataData%OutData_ExtPtfm, ErrStat, ErrMsg ) + CALL MAP_DestroyInitInput( InitDataData%InData_MAP, ErrStat, ErrMsg ) + CALL MAP_DestroyInitOutput( InitDataData%OutData_MAP, ErrStat, ErrMsg ) + CALL FEAM_DestroyInitInput( InitDataData%InData_FEAM, ErrStat, ErrMsg ) + CALL FEAM_DestroyInitOutput( InitDataData%OutData_FEAM, ErrStat, ErrMsg ) + CALL MD_DestroyInitInput( InitDataData%InData_MD, ErrStat, ErrMsg ) + CALL MD_DestroyInitOutput( InitDataData%OutData_MD, ErrStat, ErrMsg ) + CALL Orca_DestroyInitInput( InitDataData%InData_Orca, ErrStat, ErrMsg ) + CALL Orca_DestroyInitOutput( InitDataData%OutData_Orca, ErrStat, ErrMsg ) + CALL IceFloe_DestroyInitInput( InitDataData%InData_IceF, ErrStat, ErrMsg ) + CALL IceFloe_DestroyInitOutput( InitDataData%OutData_IceF, ErrStat, ErrMsg ) + CALL IceD_DestroyInitInput( InitDataData%InData_IceD, ErrStat, ErrMsg ) + CALL IceD_DestroyInitOutput( InitDataData%OutData_IceD, ErrStat, ErrMsg ) + CALL SC_DestroyInitInput( InitDataData%InData_SC, ErrStat, ErrMsg ) + CALL SC_DestroyInitOutput( InitDataData%OutData_SC, ErrStat, ErrMsg ) + END SUBROUTINE FAST_DestroyInitData + + SUBROUTINE FAST_PackInitData( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) + TYPE(FAST_InitData), INTENT(IN) :: InData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly + ! Local variables + INTEGER(IntKi) :: Re_BufSz + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_BufSz + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_BufSz + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 + LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackInitData' + ! buffers to store subtypes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - IF(ALLOCATED(Re_Buf)) THEN ! AD_L_2_BDED_B - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! AD_L_2_BDED_B - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! AD_L_2_BDED_B - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! BD_L_2_BD_L allocated yes/no - IF ( ALLOCATED(InData%BD_L_2_BD_L) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! BD_L_2_BD_L upper/lower bounds for each dimension - DO i1 = LBOUND(InData%BD_L_2_BD_L,1), UBOUND(InData%BD_L_2_BD_L,1) - Int_BufSz = Int_BufSz + 3 ! BD_L_2_BD_L: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%BD_L_2_BD_L(i1), ErrStat2, ErrMsg2, .TRUE. ) ! BD_L_2_BD_L + OnlySize = .FALSE. + IF ( PRESENT(SizeOnly) ) THEN + OnlySize = SizeOnly + ENDIF + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_BufSz = 0 + Db_BufSz = 0 + Int_BufSz = 0 + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + Int_BufSz = Int_BufSz + 3 ! InData_ED: size of buffers for each call to pack subtype + CALL ED_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_ED, ErrStat2, ErrMsg2, .TRUE. ) ! InData_ED CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! BD_L_2_BD_L + IF(ALLOCATED(Re_Buf)) THEN ! InData_ED Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! BD_L_2_BD_L + IF(ALLOCATED(Db_Buf)) THEN ! InData_ED Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! BD_L_2_BD_L + IF(ALLOCATED(Int_Buf)) THEN ! InData_ED Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! ED_L_2_AD_L_T: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_L_2_AD_L_T, ErrStat2, ErrMsg2, .TRUE. ) ! ED_L_2_AD_L_T + Int_BufSz = Int_BufSz + 3 ! OutData_ED: size of buffers for each call to pack subtype + CALL ED_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_ED, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_ED CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! ED_L_2_AD_L_T + IF(ALLOCATED(Re_Buf)) THEN ! OutData_ED Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_L_2_AD_L_T + IF(ALLOCATED(Db_Buf)) THEN ! OutData_ED Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_L_2_AD_L_T + IF(ALLOCATED(Int_Buf)) THEN ! OutData_ED Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF - Int_BufSz = Int_BufSz + 3 ! AD_L_2_ED_P_T: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_L_2_ED_P_T, ErrStat2, ErrMsg2, .TRUE. ) ! AD_L_2_ED_P_T + Int_BufSz = Int_BufSz + 3 ! InData_BD: size of buffers for each call to pack subtype + CALL BD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_BD, ErrStat2, ErrMsg2, .TRUE. ) ! InData_BD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! AD_L_2_ED_P_T + IF(ALLOCATED(Re_Buf)) THEN ! InData_BD Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! AD_L_2_ED_P_T + IF(ALLOCATED(Db_Buf)) THEN ! InData_BD Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! AD_L_2_ED_P_T + IF(ALLOCATED(Int_Buf)) THEN ! InData_BD Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF - Int_BufSz = Int_BufSz + 1 ! ED_P_2_AD_P_R allocated yes/no - IF ( ALLOCATED(InData%ED_P_2_AD_P_R) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! ED_P_2_AD_P_R upper/lower bounds for each dimension - DO i1 = LBOUND(InData%ED_P_2_AD_P_R,1), UBOUND(InData%ED_P_2_AD_P_R,1) - Int_BufSz = Int_BufSz + 3 ! ED_P_2_AD_P_R: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_R(i1), ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_AD_P_R + Int_BufSz = Int_BufSz + 1 ! OutData_BD allocated yes/no + IF ( ALLOCATED(InData%OutData_BD) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! OutData_BD upper/lower bounds for each dimension + DO i1 = LBOUND(InData%OutData_BD,1), UBOUND(InData%OutData_BD,1) + Int_BufSz = Int_BufSz + 3 ! OutData_BD: size of buffers for each call to pack subtype + CALL BD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_BD(i1), ErrStat2, ErrMsg2, .TRUE. ) ! OutData_BD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_AD_P_R + IF(ALLOCATED(Re_Buf)) THEN ! OutData_BD Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_AD_P_R + IF(ALLOCATED(Db_Buf)) THEN ! OutData_BD Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_AD_P_R + IF(ALLOCATED(Int_Buf)) THEN ! OutData_BD Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF END DO END IF - Int_BufSz = Int_BufSz + 3 ! ED_P_2_AD_P_H: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2, .TRUE. ) ! ED_P_2_AD_P_H - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ED_P_2_AD_P_H - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ED_P_2_AD_P_H - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ED_P_2_AD_P_H - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! IceF_P_2_SD_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%IceF_P_2_SD_P, ErrStat2, ErrMsg2, .TRUE. ) ! IceF_P_2_SD_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! IceF_P_2_SD_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! IceF_P_2_SD_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! IceF_P_2_SD_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 3 ! SD_P_2_IceF_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SD_P_2_IceF_P, ErrStat2, ErrMsg2, .TRUE. ) ! SD_P_2_IceF_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! SD_P_2_IceF_P - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! SD_P_2_IceF_P - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! SD_P_2_IceF_P - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! IceD_P_2_SD_P allocated yes/no - IF ( ALLOCATED(InData%IceD_P_2_SD_P) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! IceD_P_2_SD_P upper/lower bounds for each dimension - DO i1 = LBOUND(InData%IceD_P_2_SD_P,1), UBOUND(InData%IceD_P_2_SD_P,1) - Int_BufSz = Int_BufSz + 3 ! IceD_P_2_SD_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%IceD_P_2_SD_P(i1), ErrStat2, ErrMsg2, .TRUE. ) ! IceD_P_2_SD_P + Int_BufSz = Int_BufSz + 3 ! InData_SrvD: size of buffers for each call to pack subtype + CALL SrvD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_SrvD, ErrStat2, ErrMsg2, .TRUE. ) ! InData_SrvD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! IceD_P_2_SD_P + IF(ALLOCATED(Re_Buf)) THEN ! InData_SrvD Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! IceD_P_2_SD_P + IF(ALLOCATED(Db_Buf)) THEN ! InData_SrvD Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! IceD_P_2_SD_P + IF(ALLOCATED(Int_Buf)) THEN ! InData_SrvD Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! SD_P_2_IceD_P allocated yes/no - IF ( ALLOCATED(InData%SD_P_2_IceD_P) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! SD_P_2_IceD_P upper/lower bounds for each dimension - DO i1 = LBOUND(InData%SD_P_2_IceD_P,1), UBOUND(InData%SD_P_2_IceD_P,1) - Int_BufSz = Int_BufSz + 3 ! SD_P_2_IceD_P: size of buffers for each call to pack subtype - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SD_P_2_IceD_P(i1), ErrStat2, ErrMsg2, .TRUE. ) ! SD_P_2_IceD_P + Int_BufSz = Int_BufSz + 3 ! OutData_SrvD: size of buffers for each call to pack subtype + CALL SrvD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_SrvD, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_SrvD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! SD_P_2_IceD_P + IF(ALLOCATED(Re_Buf)) THEN ! OutData_SrvD Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! SD_P_2_IceD_P + IF(ALLOCATED(Db_Buf)) THEN ! OutData_SrvD Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! SD_P_2_IceD_P + IF(ALLOCATED(Int_Buf)) THEN ! OutData_SrvD Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! Jacobian_Opt1 allocated yes/no - IF ( ALLOCATED(InData%Jacobian_Opt1) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Jacobian_Opt1 upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%Jacobian_Opt1) ! Jacobian_Opt1 - END IF - Int_BufSz = Int_BufSz + 1 ! Jacobian_pivot allocated yes/no - IF ( ALLOCATED(InData%Jacobian_pivot) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! Jacobian_pivot upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Jacobian_pivot) ! Jacobian_pivot - END IF - Int_BufSz = Int_BufSz + 1 ! Jac_u_indx allocated yes/no - IF ( ALLOCATED(InData%Jac_u_indx) ) THEN - Int_BufSz = Int_BufSz + 2*2 ! Jac_u_indx upper/lower bounds for each dimension - Int_BufSz = Int_BufSz + SIZE(InData%Jac_u_indx) ! Jac_u_indx - END IF - Int_BufSz = Int_BufSz + 3 ! u_ED_PlatformPtMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_ED_PlatformPtMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_ED_PlatformPtMesh + Int_BufSz = Int_BufSz + 3 ! InData_AD14: size of buffers for each call to pack subtype + CALL AD14_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_AD14, ErrStat2, ErrMsg2, .TRUE. ) ! InData_AD14 CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! u_ED_PlatformPtMesh + IF(ALLOCATED(Re_Buf)) THEN ! InData_AD14 Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_ED_PlatformPtMesh + IF(ALLOCATED(Db_Buf)) THEN ! InData_AD14 Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_ED_PlatformPtMesh + IF(ALLOCATED(Int_Buf)) THEN ! InData_AD14 Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF - Int_BufSz = Int_BufSz + 3 ! u_ED_PlatformPtMesh_2: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_ED_PlatformPtMesh_2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_ED_PlatformPtMesh_2 + Int_BufSz = Int_BufSz + 3 ! OutData_AD14: size of buffers for each call to pack subtype + CALL AD14_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_AD14, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_AD14 CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! u_ED_PlatformPtMesh_2 + IF(ALLOCATED(Re_Buf)) THEN ! OutData_AD14 Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_ED_PlatformPtMesh_2 + IF(ALLOCATED(Db_Buf)) THEN ! OutData_AD14 Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_ED_PlatformPtMesh_2 + IF(ALLOCATED(Int_Buf)) THEN ! OutData_AD14 Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF - Int_BufSz = Int_BufSz + 3 ! u_SD_TPMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_SD_TPMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_SD_TPMesh + Int_BufSz = Int_BufSz + 3 ! InData_AD: size of buffers for each call to pack subtype + CALL AD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_AD, ErrStat2, ErrMsg2, .TRUE. ) ! InData_AD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! u_SD_TPMesh + IF(ALLOCATED(Re_Buf)) THEN ! InData_AD Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_SD_TPMesh + IF(ALLOCATED(Db_Buf)) THEN ! InData_AD Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_SD_TPMesh + IF(ALLOCATED(Int_Buf)) THEN ! InData_AD Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF - Int_BufSz = Int_BufSz + 3 ! u_SD_LMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_SD_LMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_SD_LMesh + Int_BufSz = Int_BufSz + 3 ! OutData_AD: size of buffers for each call to pack subtype + CALL AD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_AD, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_AD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! u_SD_LMesh + IF(ALLOCATED(Re_Buf)) THEN ! OutData_AD Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_SD_LMesh + IF(ALLOCATED(Db_Buf)) THEN ! OutData_AD Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_SD_LMesh + IF(ALLOCATED(Int_Buf)) THEN ! OutData_AD Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF - Int_BufSz = Int_BufSz + 3 ! u_SD_LMesh_2: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_SD_LMesh_2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_SD_LMesh_2 + Int_BufSz = Int_BufSz + 3 ! InData_IfW: size of buffers for each call to pack subtype + CALL InflowWind_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_IfW, ErrStat2, ErrMsg2, .TRUE. ) ! InData_IfW CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! u_SD_LMesh_2 + IF(ALLOCATED(Re_Buf)) THEN ! InData_IfW Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_SD_LMesh_2 + IF(ALLOCATED(Db_Buf)) THEN ! InData_IfW Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_SD_LMesh_2 + IF(ALLOCATED(Int_Buf)) THEN ! InData_IfW Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF - Int_BufSz = Int_BufSz + 3 ! u_HD_M_LumpedMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_HD_M_LumpedMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_HD_M_LumpedMesh + Int_BufSz = Int_BufSz + 3 ! OutData_IfW: size of buffers for each call to pack subtype + CALL InflowWind_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_IfW, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_IfW CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! u_HD_M_LumpedMesh + IF(ALLOCATED(Re_Buf)) THEN ! OutData_IfW Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_HD_M_LumpedMesh + IF(ALLOCATED(Db_Buf)) THEN ! OutData_IfW Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_HD_M_LumpedMesh + IF(ALLOCATED(Int_Buf)) THEN ! OutData_IfW Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF - Int_BufSz = Int_BufSz + 3 ! u_HD_M_DistribMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_HD_M_DistribMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_HD_M_DistribMesh + Int_BufSz = Int_BufSz + 3 ! InData_OpFM: size of buffers for each call to pack subtype + CALL OpFM_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_OpFM, ErrStat2, ErrMsg2, .TRUE. ) ! InData_OpFM CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! u_HD_M_DistribMesh + IF(ALLOCATED(Re_Buf)) THEN ! InData_OpFM Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_HD_M_DistribMesh + IF(ALLOCATED(Db_Buf)) THEN ! InData_OpFM Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_HD_M_DistribMesh + IF(ALLOCATED(Int_Buf)) THEN ! InData_OpFM Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF - Int_BufSz = Int_BufSz + 3 ! u_HD_Mesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_HD_Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_HD_Mesh + Int_BufSz = Int_BufSz + 3 ! OutData_OpFM: size of buffers for each call to pack subtype + CALL OpFM_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_OpFM, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_OpFM CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! u_HD_Mesh + IF(ALLOCATED(Re_Buf)) THEN ! OutData_OpFM Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_HD_Mesh + IF(ALLOCATED(Db_Buf)) THEN ! OutData_OpFM Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_HD_Mesh + IF(ALLOCATED(Int_Buf)) THEN ! OutData_OpFM Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF - Int_BufSz = Int_BufSz + 3 ! u_ED_HubPtLoad: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_ED_HubPtLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_ED_HubPtLoad + Int_BufSz = Int_BufSz + 3 ! InData_HD: size of buffers for each call to pack subtype + CALL HydroDyn_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_HD, ErrStat2, ErrMsg2, .TRUE. ) ! InData_HD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! u_ED_HubPtLoad + IF(ALLOCATED(Re_Buf)) THEN ! InData_HD Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_ED_HubPtLoad + IF(ALLOCATED(Db_Buf)) THEN ! InData_HD Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_ED_HubPtLoad + IF(ALLOCATED(Int_Buf)) THEN ! InData_HD Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF - Int_BufSz = Int_BufSz + 3 ! u_ED_HubPtLoad_2: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_ED_HubPtLoad_2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_ED_HubPtLoad_2 + Int_BufSz = Int_BufSz + 3 ! OutData_HD: size of buffers for each call to pack subtype + CALL HydroDyn_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_HD, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_HD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! u_ED_HubPtLoad_2 + IF(ALLOCATED(Re_Buf)) THEN ! OutData_HD Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_ED_HubPtLoad_2 + IF(ALLOCATED(Db_Buf)) THEN ! OutData_HD Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_ED_HubPtLoad_2 + IF(ALLOCATED(Int_Buf)) THEN ! OutData_HD Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF - Int_BufSz = Int_BufSz + 1 ! u_BD_RootMotion allocated yes/no - IF ( ALLOCATED(InData%u_BD_RootMotion) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! u_BD_RootMotion upper/lower bounds for each dimension - DO i1 = LBOUND(InData%u_BD_RootMotion,1), UBOUND(InData%u_BD_RootMotion,1) - Int_BufSz = Int_BufSz + 3 ! u_BD_RootMotion: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_BD_RootMotion(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_BD_RootMotion + Int_BufSz = Int_BufSz + 3 ! InData_SD: size of buffers for each call to pack subtype + CALL SD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_SD, ErrStat2, ErrMsg2, .TRUE. ) ! InData_SD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! u_BD_RootMotion + IF(ALLOCATED(Re_Buf)) THEN ! InData_SD Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_BD_RootMotion + IF(ALLOCATED(Db_Buf)) THEN ! InData_SD Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_BD_RootMotion + IF(ALLOCATED(Int_Buf)) THEN ! InData_SD Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF - END DO - END IF - Int_BufSz = Int_BufSz + 1 ! y_BD_BldMotion_4Loads allocated yes/no - IF ( ALLOCATED(InData%y_BD_BldMotion_4Loads) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! y_BD_BldMotion_4Loads upper/lower bounds for each dimension - DO i1 = LBOUND(InData%y_BD_BldMotion_4Loads,1), UBOUND(InData%y_BD_BldMotion_4Loads,1) - Int_BufSz = Int_BufSz + 3 ! y_BD_BldMotion_4Loads: size of buffers for each call to pack subtype - CALL MeshPack( InData%y_BD_BldMotion_4Loads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! y_BD_BldMotion_4Loads + Int_BufSz = Int_BufSz + 3 ! OutData_SD: size of buffers for each call to pack subtype + CALL SD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_SD, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_SD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! y_BD_BldMotion_4Loads + IF(ALLOCATED(Re_Buf)) THEN ! OutData_SD Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! y_BD_BldMotion_4Loads + IF(ALLOCATED(Db_Buf)) THEN ! OutData_SD Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! y_BD_BldMotion_4Loads + IF(ALLOCATED(Int_Buf)) THEN ! OutData_SD Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF - END DO - END IF - Int_BufSz = Int_BufSz + 3 ! u_Orca_PtfmMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_Orca_PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_Orca_PtfmMesh + Int_BufSz = Int_BufSz + 3 ! InData_ExtPtfm: size of buffers for each call to pack subtype + CALL ExtPtfm_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_ExtPtfm, ErrStat2, ErrMsg2, .TRUE. ) ! InData_ExtPtfm CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! u_Orca_PtfmMesh + IF(ALLOCATED(Re_Buf)) THEN ! InData_ExtPtfm Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_Orca_PtfmMesh + IF(ALLOCATED(Db_Buf)) THEN ! InData_ExtPtfm Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_Orca_PtfmMesh + IF(ALLOCATED(Int_Buf)) THEN ! InData_ExtPtfm Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF - Int_BufSz = Int_BufSz + 3 ! u_ExtPtfm_PtfmMesh: size of buffers for each call to pack subtype - CALL MeshPack( InData%u_ExtPtfm_PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! u_ExtPtfm_PtfmMesh + Int_BufSz = Int_BufSz + 3 ! OutData_ExtPtfm: size of buffers for each call to pack subtype + CALL ExtPtfm_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_ExtPtfm, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_ExtPtfm CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN ! u_ExtPtfm_PtfmMesh + IF(ALLOCATED(Re_Buf)) THEN ! OutData_ExtPtfm Re_BufSz = Re_BufSz + SIZE( Re_Buf ) DEALLOCATE(Re_Buf) END IF - IF(ALLOCATED(Db_Buf)) THEN ! u_ExtPtfm_PtfmMesh + IF(ALLOCATED(Db_Buf)) THEN ! OutData_ExtPtfm Db_BufSz = Db_BufSz + SIZE( Db_Buf ) DEALLOCATE(Db_Buf) END IF - IF(ALLOCATED(Int_Buf)) THEN ! u_ExtPtfm_PtfmMesh + IF(ALLOCATED(Int_Buf)) THEN ! OutData_ExtPtfm Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - IF ( .NOT. ALLOCATED(InData%ED_P_2_BD_P) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ED_P_2_BD_P,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ED_P_2_BD_P,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ED_P_2_BD_P,1), UBOUND(InData%ED_P_2_BD_P,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_BD_P(i1), ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_BD_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BD_P_2_ED_P) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BD_P_2_ED_P,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BD_P_2_ED_P,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BD_P_2_ED_P,1), UBOUND(InData%BD_P_2_ED_P,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%BD_P_2_ED_P(i1), ErrStat2, ErrMsg2, OnlySize ) ! BD_P_2_ED_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%ED_P_2_BD_P_Hub) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ED_P_2_BD_P_Hub,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ED_P_2_BD_P_Hub,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ED_P_2_BD_P_Hub,1), UBOUND(InData%ED_P_2_BD_P_Hub,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_BD_P_Hub(i1), ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_BD_P_Hub - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END DO - END IF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_HD_W_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%HD_W_P_2_ED_P, ErrStat2, ErrMsg2, OnlySize ) ! HD_W_P_2_ED_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_HD_M_P, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_HD_M_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%HD_M_P_2_ED_P, ErrStat2, ErrMsg2, OnlySize ) ! HD_M_P_2_ED_P + Int_BufSz = Int_BufSz + 3 ! InData_MAP: size of buffers for each call to pack subtype + CALL MAP_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_MAP, ErrStat2, ErrMsg2, .TRUE. ) ! InData_MAP CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_HD_M_L, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_HD_M_L + IF(ALLOCATED(Re_Buf)) THEN ! InData_MAP + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! InData_MAP + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! InData_MAP + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! OutData_MAP: size of buffers for each call to pack subtype + CALL MAP_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_MAP, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_MAP CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%HD_M_L_2_ED_P, ErrStat2, ErrMsg2, OnlySize ) ! HD_M_L_2_ED_P + IF(ALLOCATED(Re_Buf)) THEN ! OutData_MAP + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OutData_MAP + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OutData_MAP + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! InData_FEAM: size of buffers for each call to pack subtype + CALL FEAM_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_FEAM, ErrStat2, ErrMsg2, .TRUE. ) ! InData_FEAM CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_Mooring_P + IF(ALLOCATED(Re_Buf)) THEN ! InData_FEAM + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! InData_FEAM + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! InData_FEAM + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! OutData_FEAM: size of buffers for each call to pack subtype + CALL FEAM_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_FEAM, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_FEAM CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2, OnlySize ) ! Mooring_P_2_ED_P + IF(ALLOCATED(Re_Buf)) THEN ! OutData_FEAM + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OutData_FEAM + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OutData_FEAM + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! InData_MD: size of buffers for each call to pack subtype + CALL MD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_MD, ErrStat2, ErrMsg2, .TRUE. ) ! InData_MD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_SD_TP, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_SD_TP + IF(ALLOCATED(Re_Buf)) THEN ! InData_MD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! InData_MD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! InData_MD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! OutData_MD: size of buffers for each call to pack subtype + CALL MD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_MD, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_MD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SD_TP_2_ED_P, ErrStat2, ErrMsg2, OnlySize ) ! SD_TP_2_ED_P + IF(ALLOCATED(Re_Buf)) THEN ! OutData_MD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OutData_MD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OutData_MD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! InData_Orca: size of buffers for each call to pack subtype + CALL Orca_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_Orca, ErrStat2, ErrMsg2, .TRUE. ) ! InData_Orca CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SD_P_2_HD_M_P, ErrStat2, ErrMsg2, OnlySize ) ! SD_P_2_HD_M_P + IF(ALLOCATED(Re_Buf)) THEN ! InData_Orca + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! InData_Orca + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! InData_Orca + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! OutData_Orca: size of buffers for each call to pack subtype + CALL Orca_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_Orca, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_Orca CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%HD_M_P_2_SD_P, ErrStat2, ErrMsg2, OnlySize ) ! HD_M_P_2_SD_P + IF(ALLOCATED(Re_Buf)) THEN ! OutData_Orca + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OutData_Orca + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OutData_Orca + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! InData_IceF: size of buffers for each call to pack subtype + CALL IceFloe_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_IceF, ErrStat2, ErrMsg2, .TRUE. ) ! InData_IceF CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SD_P_2_HD_M_L, ErrStat2, ErrMsg2, OnlySize ) ! SD_P_2_HD_M_L + IF(ALLOCATED(Re_Buf)) THEN ! InData_IceF + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! InData_IceF + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! InData_IceF + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! OutData_IceF: size of buffers for each call to pack subtype + CALL IceFloe_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_IceF, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_IceF CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%HD_M_L_2_SD_P, ErrStat2, ErrMsg2, OnlySize ) ! HD_M_L_2_SD_P + IF(ALLOCATED(Re_Buf)) THEN ! OutData_IceF + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OutData_IceF + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OutData_IceF + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! InData_IceD: size of buffers for each call to pack subtype + CALL IceD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_IceD, ErrStat2, ErrMsg2, .TRUE. ) ! InData_IceD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_SrvD_P_N, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_SrvD_P_N + IF(ALLOCATED(Re_Buf)) THEN ! InData_IceD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! InData_IceD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! InData_IceD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! OutData_IceD: size of buffers for each call to pack subtype + CALL IceD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_IceD, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_IceD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SrvD_P_2_ED_P_N, ErrStat2, ErrMsg2, OnlySize ) ! SrvD_P_2_ED_P_N + IF(ALLOCATED(Re_Buf)) THEN ! OutData_IceD + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OutData_IceD + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OutData_IceD + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! InData_SC: size of buffers for each call to pack subtype + CALL SC_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_SC, ErrStat2, ErrMsg2, .TRUE. ) ! InData_SC + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! InData_SC + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! InData_SC + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! InData_SC + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! OutData_SC: size of buffers for each call to pack subtype + CALL SC_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_SC, ErrStat2, ErrMsg2, .TRUE. ) ! OutData_SC + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! OutData_SC + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! OutData_SC + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! OutData_SC + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + IF ( Re_BufSz .GT. 0 ) THEN + ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Db_BufSz .GT. 0 ) THEN + ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF ( Int_BufSz .GT. 0 ) THEN + ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) + + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 + + CALL ED_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_ED, ErrStat2, ErrMsg2, OnlySize ) ! InData_ED CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -25333,7 +41554,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_L_2_SrvD_P_T, ErrStat2, ErrMsg2, OnlySize ) ! ED_L_2_SrvD_P_T + CALL ED_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_ED, ErrStat2, ErrMsg2, OnlySize ) ! OutData_ED CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -25361,7 +41582,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SrvD_P_2_ED_P_T, ErrStat2, ErrMsg2, OnlySize ) ! SrvD_P_2_ED_P_T + CALL BD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_BD, ErrStat2, ErrMsg2, OnlySize ) ! InData_BD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -25389,18 +41610,18 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - IF ( .NOT. ALLOCATED(InData%BDED_L_2_AD_L_B) ) THEN + IF ( .NOT. ALLOCATED(InData%OutData_BD) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 ELSE IntKiBuf( Int_Xferred ) = 1 Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BDED_L_2_AD_L_B,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BDED_L_2_AD_L_B,1) + IntKiBuf( Int_Xferred ) = LBOUND(InData%OutData_BD,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutData_BD,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%BDED_L_2_AD_L_B,1), UBOUND(InData%BDED_L_2_AD_L_B,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%BDED_L_2_AD_L_B(i1), ErrStat2, ErrMsg2, OnlySize ) ! BDED_L_2_AD_L_B + DO i1 = LBOUND(InData%OutData_BD,1), UBOUND(InData%OutData_BD,1) + CALL BD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_BD(i1), ErrStat2, ErrMsg2, OnlySize ) ! OutData_BD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -25430,18 +41651,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ENDIF END DO END IF - IF ( .NOT. ALLOCATED(InData%AD_L_2_BDED_B) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%AD_L_2_BDED_B,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AD_L_2_BDED_B,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%AD_L_2_BDED_B,1), UBOUND(InData%AD_L_2_BDED_B,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_L_2_BDED_B(i1), ErrStat2, ErrMsg2, OnlySize ) ! AD_L_2_BDED_B + CALL SrvD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_SrvD, ErrStat2, ErrMsg2, OnlySize ) ! InData_SrvD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -25469,20 +41679,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%BD_L_2_BD_L) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%BD_L_2_BD_L,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BD_L_2_BD_L,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%BD_L_2_BD_L,1), UBOUND(InData%BD_L_2_BD_L,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%BD_L_2_BD_L(i1), ErrStat2, ErrMsg2, OnlySize ) ! BD_L_2_BD_L + CALL SrvD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_SrvD, ErrStat2, ErrMsg2, OnlySize ) ! OutData_SrvD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -25510,9 +41707,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - END DO - END IF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_L_2_AD_L_T, ErrStat2, ErrMsg2, OnlySize ) ! ED_L_2_AD_L_T + CALL AD14_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_AD14, ErrStat2, ErrMsg2, OnlySize ) ! InData_AD14 CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -25540,7 +41735,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%AD_L_2_ED_P_T, ErrStat2, ErrMsg2, OnlySize ) ! AD_L_2_ED_P_T + CALL AD14_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_AD14, ErrStat2, ErrMsg2, OnlySize ) ! OutData_AD14 CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -25564,22 +41759,11 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF ( .NOT. ALLOCATED(InData%ED_P_2_AD_P_R) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%ED_P_2_AD_P_R,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ED_P_2_AD_P_R,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%ED_P_2_AD_P_R,1), UBOUND(InData%ED_P_2_AD_P_R,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_R(i1), ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_AD_P_R + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL AD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_AD, ErrStat2, ErrMsg2, OnlySize ) ! InData_AD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -25607,9 +41791,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - END DO - END IF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2, OnlySize ) ! ED_P_2_AD_P_H + CALL AD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_AD, ErrStat2, ErrMsg2, OnlySize ) ! OutData_AD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -25637,7 +41819,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%IceF_P_2_SD_P, ErrStat2, ErrMsg2, OnlySize ) ! IceF_P_2_SD_P + CALL InflowWind_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_IfW, ErrStat2, ErrMsg2, OnlySize ) ! InData_IfW CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -25665,7 +41847,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SD_P_2_IceF_P, ErrStat2, ErrMsg2, OnlySize ) ! SD_P_2_IceF_P + CALL InflowWind_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_IfW, ErrStat2, ErrMsg2, OnlySize ) ! OutData_IfW CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -25693,18 +41875,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - IF ( .NOT. ALLOCATED(InData%IceD_P_2_SD_P) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%IceD_P_2_SD_P,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IceD_P_2_SD_P,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%IceD_P_2_SD_P,1), UBOUND(InData%IceD_P_2_SD_P,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%IceD_P_2_SD_P(i1), ErrStat2, ErrMsg2, OnlySize ) ! IceD_P_2_SD_P + CALL OpFM_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_OpFM, ErrStat2, ErrMsg2, OnlySize ) ! InData_OpFM CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -25732,20 +41903,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%SD_P_2_IceD_P) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%SD_P_2_IceD_P,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SD_P_2_IceD_P,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%SD_P_2_IceD_P,1), UBOUND(InData%SD_P_2_IceD_P,1) - CALL NWTC_Library_Packmeshmaptype( Re_Buf, Db_Buf, Int_Buf, InData%SD_P_2_IceD_P(i1), ErrStat2, ErrMsg2, OnlySize ) ! SD_P_2_IceD_P + CALL OpFM_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_OpFM, ErrStat2, ErrMsg2, OnlySize ) ! OutData_OpFM CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -25773,54 +41931,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%Jacobian_Opt1) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jacobian_Opt1,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jacobian_Opt1,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jacobian_Opt1,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jacobian_Opt1,2) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%Jacobian_Opt1)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Jacobian_Opt1))-1 ) = PACK(InData%Jacobian_Opt1,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Jacobian_Opt1) - END IF - IF ( .NOT. ALLOCATED(InData%Jacobian_pivot) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jacobian_pivot,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jacobian_pivot,1) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%Jacobian_pivot)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%Jacobian_pivot))-1 ) = PACK(InData%Jacobian_pivot,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%Jacobian_pivot) - END IF - IF ( .NOT. ALLOCATED(InData%Jac_u_indx) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_u_indx,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,1) - Int_Xferred = Int_Xferred + 2 - IntKiBuf( Int_Xferred ) = LBOUND(InData%Jac_u_indx,2) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Jac_u_indx,2) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%Jac_u_indx)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%Jac_u_indx))-1 ) = PACK(InData%Jac_u_indx,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%Jac_u_indx) - END IF - CALL MeshPack( InData%u_ED_PlatformPtMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_ED_PlatformPtMesh + CALL HydroDyn_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_HD, ErrStat2, ErrMsg2, OnlySize ) ! InData_HD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -25848,7 +41959,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL MeshPack( InData%u_ED_PlatformPtMesh_2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_ED_PlatformPtMesh_2 + CALL HydroDyn_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_HD, ErrStat2, ErrMsg2, OnlySize ) ! OutData_HD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -25876,7 +41987,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL MeshPack( InData%u_SD_TPMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_SD_TPMesh + CALL SD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_SD, ErrStat2, ErrMsg2, OnlySize ) ! InData_SD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -25904,7 +42015,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL MeshPack( InData%u_SD_LMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_SD_LMesh + CALL SD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_SD, ErrStat2, ErrMsg2, OnlySize ) ! OutData_SD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -25932,7 +42043,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL MeshPack( InData%u_SD_LMesh_2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_SD_LMesh_2 + CALL ExtPtfm_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_ExtPtfm, ErrStat2, ErrMsg2, OnlySize ) ! InData_ExtPtfm CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -25960,7 +42071,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL MeshPack( InData%u_HD_M_LumpedMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_HD_M_LumpedMesh + CALL ExtPtfm_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_ExtPtfm, ErrStat2, ErrMsg2, OnlySize ) ! OutData_ExtPtfm CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -25988,7 +42099,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL MeshPack( InData%u_HD_M_DistribMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_HD_M_DistribMesh + CALL MAP_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_MAP, ErrStat2, ErrMsg2, OnlySize ) ! InData_MAP CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -26016,7 +42127,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL MeshPack( InData%u_HD_Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_HD_Mesh + CALL MAP_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_MAP, ErrStat2, ErrMsg2, OnlySize ) ! OutData_MAP CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -26044,7 +42155,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL MeshPack( InData%u_ED_HubPtLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_ED_HubPtLoad + CALL FEAM_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_FEAM, ErrStat2, ErrMsg2, OnlySize ) ! InData_FEAM CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -26072,7 +42183,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL MeshPack( InData%u_ED_HubPtLoad_2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_ED_HubPtLoad_2 + CALL FEAM_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_FEAM, ErrStat2, ErrMsg2, OnlySize ) ! OutData_FEAM CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -26100,18 +42211,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - IF ( .NOT. ALLOCATED(InData%u_BD_RootMotion) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%u_BD_RootMotion,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u_BD_RootMotion,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%u_BD_RootMotion,1), UBOUND(InData%u_BD_RootMotion,1) - CALL MeshPack( InData%u_BD_RootMotion(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_BD_RootMotion + CALL MD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_MD, ErrStat2, ErrMsg2, OnlySize ) ! InData_MD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -26139,20 +42239,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - END DO - END IF - IF ( .NOT. ALLOCATED(InData%y_BD_BldMotion_4Loads) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%y_BD_BldMotion_4Loads,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%y_BD_BldMotion_4Loads,1) - Int_Xferred = Int_Xferred + 2 - - DO i1 = LBOUND(InData%y_BD_BldMotion_4Loads,1), UBOUND(InData%y_BD_BldMotion_4Loads,1) - CALL MeshPack( InData%y_BD_BldMotion_4Loads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! y_BD_BldMotion_4Loads + CALL MD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_MD, ErrStat2, ErrMsg2, OnlySize ) ! OutData_MD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -26180,9 +42267,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - END DO - END IF - CALL MeshPack( InData%u_Orca_PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_Orca_PtfmMesh + CALL Orca_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_Orca, ErrStat2, ErrMsg2, OnlySize ) ! InData_Orca CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -26210,7 +42295,7 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - CALL MeshPack( InData%u_ExtPtfm_PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! u_ExtPtfm_PtfmMesh + CALL Orca_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_Orca, ErrStat2, ErrMsg2, OnlySize ) ! OutData_Orca CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -26234,574 +42319,207 @@ SUBROUTINE FAST_PackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - END SUBROUTINE FAST_PackModuleMapType - - SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FAST_ModuleMapType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackModuleMapType' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ED_P_2_BD_P not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ED_P_2_BD_P)) DEALLOCATE(OutData%ED_P_2_BD_P) - ALLOCATE(OutData%ED_P_2_BD_P(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_P_2_BD_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ED_P_2_BD_P,1), UBOUND(OutData%ED_P_2_BD_P,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_BD_P(i1), ErrStat2, ErrMsg2 ) ! ED_P_2_BD_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BD_P_2_ED_P not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BD_P_2_ED_P)) DEALLOCATE(OutData%BD_P_2_ED_P) - ALLOCATE(OutData%BD_P_2_ED_P(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BD_P_2_ED_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BD_P_2_ED_P,1), UBOUND(OutData%BD_P_2_ED_P,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%BD_P_2_ED_P(i1), ErrStat2, ErrMsg2 ) ! BD_P_2_ED_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ED_P_2_BD_P_Hub not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ED_P_2_BD_P_Hub)) DEALLOCATE(OutData%ED_P_2_BD_P_Hub) - ALLOCATE(OutData%ED_P_2_BD_P_Hub(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_P_2_BD_P_Hub.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ED_P_2_BD_P_Hub,1), UBOUND(OutData%ED_P_2_BD_P_Hub,1) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_BD_P_Hub(i1), ErrStat2, ErrMsg2 ) ! ED_P_2_BD_P_Hub - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_HD_W_P, ErrStat2, ErrMsg2 ) ! ED_P_2_HD_W_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%HD_W_P_2_ED_P, ErrStat2, ErrMsg2 ) ! HD_W_P_2_ED_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_HD_M_P, ErrStat2, ErrMsg2 ) ! ED_P_2_HD_M_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%HD_M_P_2_ED_P, ErrStat2, ErrMsg2 ) ! HD_M_P_2_ED_P - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_HD_M_L, ErrStat2, ErrMsg2 ) ! ED_P_2_HD_M_L + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL IceFloe_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_IceF, ErrStat2, ErrMsg2, OnlySize ) ! InData_IceF CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%HD_M_L_2_ED_P, ErrStat2, ErrMsg2 ) ! HD_M_L_2_ED_P + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL IceFloe_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_IceF, ErrStat2, ErrMsg2, OnlySize ) ! OutData_IceF CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_Mooring_P, ErrStat2, ErrMsg2 ) ! ED_P_2_Mooring_P + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL IceD_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_IceD, ErrStat2, ErrMsg2, OnlySize ) ! InData_IceD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%Mooring_P_2_ED_P, ErrStat2, ErrMsg2 ) ! Mooring_P_2_ED_P + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL IceD_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_IceD, ErrStat2, ErrMsg2, OnlySize ) ! OutData_IceD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_SD_TP, ErrStat2, ErrMsg2 ) ! ED_P_2_SD_TP + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL SC_PackInitInput( Re_Buf, Db_Buf, Int_Buf, InData%InData_SC, ErrStat2, ErrMsg2, OnlySize ) ! InData_SC CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL SC_PackInitOutput( Re_Buf, Db_Buf, Int_Buf, InData%OutData_SC, ErrStat2, ErrMsg2, OnlySize ) ! OutData_SC + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END SUBROUTINE FAST_PackInitData + + SUBROUTINE FAST_UnPackInitData( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) + REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) + INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) + TYPE(FAST_InitData), INTENT(INOUT) :: OutData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + ! Local variables + INTEGER(IntKi) :: Buf_size + INTEGER(IntKi) :: Re_Xferred + INTEGER(IntKi) :: Db_Xferred + INTEGER(IntKi) :: Int_Xferred + INTEGER(IntKi) :: i + INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackInitData' + ! buffers to store meshes, if any + REAL(ReKi), ALLOCATABLE :: Re_Buf(:) + REAL(DbKi), ALLOCATABLE :: Db_Buf(:) + INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) + ! + ErrStat = ErrID_None + ErrMsg = "" + Re_Xferred = 1 + Db_Xferred = 1 + Int_Xferred = 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -26835,7 +42553,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%SD_TP_2_ED_P, ErrStat2, ErrMsg2 ) ! SD_TP_2_ED_P + CALL ED_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_ED, ErrStat2, ErrMsg2 ) ! InData_ED CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -26875,7 +42593,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%SD_P_2_HD_M_P, ErrStat2, ErrMsg2 ) ! SD_P_2_HD_M_P + CALL ED_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_ED, ErrStat2, ErrMsg2 ) ! OutData_ED CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -26915,13 +42633,27 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%HD_M_P_2_SD_P, ErrStat2, ErrMsg2 ) ! HD_M_P_2_SD_P + CALL BD_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_BD, ErrStat2, ErrMsg2 ) ! InData_BD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutData_BD not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%OutData_BD)) DEALLOCATE(OutData%OutData_BD) + ALLOCATE(OutData%OutData_BD(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutData_BD.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + DO i1 = LBOUND(OutData%OutData_BD,1), UBOUND(OutData%OutData_BD,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -26955,13 +42687,15 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%SD_P_2_HD_M_L, ErrStat2, ErrMsg2 ) ! SD_P_2_HD_M_L + CALL BD_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_BD(i1), ErrStat2, ErrMsg2 ) ! OutData_BD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -26995,7 +42729,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%HD_M_L_2_SD_P, ErrStat2, ErrMsg2 ) ! HD_M_L_2_SD_P + CALL SrvD_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_SrvD, ErrStat2, ErrMsg2 ) ! InData_SrvD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -27035,7 +42769,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_SrvD_P_N, ErrStat2, ErrMsg2 ) ! ED_P_2_SrvD_P_N + CALL SrvD_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_SrvD, ErrStat2, ErrMsg2 ) ! OutData_SrvD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -27075,7 +42809,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%SrvD_P_2_ED_P_N, ErrStat2, ErrMsg2 ) ! SrvD_P_2_ED_P_N + CALL AD14_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_AD14, ErrStat2, ErrMsg2 ) ! InData_AD14 CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -27115,7 +42849,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_L_2_SrvD_P_T, ErrStat2, ErrMsg2 ) ! ED_L_2_SrvD_P_T + CALL AD14_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_AD14, ErrStat2, ErrMsg2 ) ! OutData_AD14 CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -27155,27 +42889,13 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%SrvD_P_2_ED_P_T, ErrStat2, ErrMsg2 ) ! SrvD_P_2_ED_P_T + CALL AD_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_AD, ErrStat2, ErrMsg2 ) ! InData_AD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BDED_L_2_AD_L_B not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BDED_L_2_AD_L_B)) DEALLOCATE(OutData%BDED_L_2_AD_L_B) - ALLOCATE(OutData%BDED_L_2_AD_L_B(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BDED_L_2_AD_L_B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BDED_L_2_AD_L_B,1), UBOUND(OutData%BDED_L_2_AD_L_B,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -27209,29 +42929,13 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%BDED_L_2_AD_L_B(i1), ErrStat2, ErrMsg2 ) ! BDED_L_2_AD_L_B + CALL AD_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_AD, ErrStat2, ErrMsg2 ) ! OutData_AD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AD_L_2_BDED_B not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%AD_L_2_BDED_B)) DEALLOCATE(OutData%AD_L_2_BDED_B) - ALLOCATE(OutData%AD_L_2_BDED_B(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AD_L_2_BDED_B.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%AD_L_2_BDED_B,1), UBOUND(OutData%AD_L_2_BDED_B,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -27265,29 +42969,13 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%AD_L_2_BDED_B(i1), ErrStat2, ErrMsg2 ) ! AD_L_2_BDED_B + CALL InflowWind_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_IfW, ErrStat2, ErrMsg2 ) ! InData_IfW CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BD_L_2_BD_L not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%BD_L_2_BD_L)) DEALLOCATE(OutData%BD_L_2_BD_L) - ALLOCATE(OutData%BD_L_2_BD_L(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BD_L_2_BD_L.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%BD_L_2_BD_L,1), UBOUND(OutData%BD_L_2_BD_L,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -27321,15 +43009,13 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%BD_L_2_BD_L(i1), ErrStat2, ErrMsg2 ) ! BD_L_2_BD_L + CALL InflowWind_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_IfW, ErrStat2, ErrMsg2 ) ! OutData_IfW CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -27363,7 +43049,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_L_2_AD_L_T, ErrStat2, ErrMsg2 ) ! ED_L_2_AD_L_T + CALL OpFM_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_OpFM, ErrStat2, ErrMsg2 ) ! InData_OpFM CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -27403,27 +43089,13 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%AD_L_2_ED_P_T, ErrStat2, ErrMsg2 ) ! AD_L_2_ED_P_T + CALL OpFM_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_OpFM, ErrStat2, ErrMsg2 ) ! OutData_OpFM CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ED_P_2_AD_P_R not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%ED_P_2_AD_P_R)) DEALLOCATE(OutData%ED_P_2_AD_P_R) - ALLOCATE(OutData%ED_P_2_AD_P_R(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ED_P_2_AD_P_R.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%ED_P_2_AD_P_R,1), UBOUND(OutData%ED_P_2_AD_P_R,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -27457,15 +43129,13 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_AD_P_R(i1), ErrStat2, ErrMsg2 ) ! ED_P_2_AD_P_R + CALL HydroDyn_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_HD, ErrStat2, ErrMsg2 ) ! InData_HD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -27499,7 +43169,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%ED_P_2_AD_P_H, ErrStat2, ErrMsg2 ) ! ED_P_2_AD_P_H + CALL HydroDyn_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_HD, ErrStat2, ErrMsg2 ) ! OutData_HD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -27539,7 +43209,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%IceF_P_2_SD_P, ErrStat2, ErrMsg2 ) ! IceF_P_2_SD_P + CALL SD_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_SD, ErrStat2, ErrMsg2 ) ! InData_SD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -27579,27 +43249,13 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%SD_P_2_IceF_P, ErrStat2, ErrMsg2 ) ! SD_P_2_IceF_P + CALL SD_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_SD, ErrStat2, ErrMsg2 ) ! OutData_SD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IceD_P_2_SD_P not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%IceD_P_2_SD_P)) DEALLOCATE(OutData%IceD_P_2_SD_P) - ALLOCATE(OutData%IceD_P_2_SD_P(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IceD_P_2_SD_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%IceD_P_2_SD_P,1), UBOUND(OutData%IceD_P_2_SD_P,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -27633,29 +43289,13 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%IceD_P_2_SD_P(i1), ErrStat2, ErrMsg2 ) ! IceD_P_2_SD_P + CALL ExtPtfm_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_ExtPtfm, ErrStat2, ErrMsg2 ) ! InData_ExtPtfm CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SD_P_2_IceD_P not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SD_P_2_IceD_P)) DEALLOCATE(OutData%SD_P_2_IceD_P) - ALLOCATE(OutData%SD_P_2_IceD_P(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SD_P_2_IceD_P.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%SD_P_2_IceD_P,1), UBOUND(OutData%SD_P_2_IceD_P,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -27689,90 +43329,13 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL NWTC_Library_Unpackmeshmaptype( Re_Buf, Db_Buf, Int_Buf, OutData%SD_P_2_IceD_P(i1), ErrStat2, ErrMsg2 ) ! SD_P_2_IceD_P + CALL ExtPtfm_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_ExtPtfm, ErrStat2, ErrMsg2 ) ! OutData_ExtPtfm CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jacobian_Opt1 not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Jacobian_Opt1)) DEALLOCATE(OutData%Jacobian_Opt1) - ALLOCATE(OutData%Jacobian_Opt1(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jacobian_Opt1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Jacobian_Opt1)>0) OutData%Jacobian_Opt1 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Jacobian_Opt1))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Jacobian_Opt1) - DEALLOCATE(mask2) - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jacobian_pivot not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Jacobian_pivot)) DEALLOCATE(OutData%Jacobian_pivot) - ALLOCATE(OutData%Jacobian_pivot(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jacobian_pivot.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Jacobian_pivot)>0) OutData%Jacobian_pivot = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%Jacobian_pivot))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%Jacobian_pivot) - DEALLOCATE(mask1) - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Jac_u_indx not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - i2_l = IntKiBuf( Int_Xferred ) - i2_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%Jac_u_indx)) DEALLOCATE(OutData%Jac_u_indx) - ALLOCATE(OutData%Jac_u_indx(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Jac_u_indx.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Jac_u_indx)>0) OutData%Jac_u_indx = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%Jac_u_indx))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%Jac_u_indx) - DEALLOCATE(mask2) - END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -27806,7 +43369,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MeshUnpack( OutData%u_ED_PlatformPtMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_ED_PlatformPtMesh + CALL MAP_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_MAP, ErrStat2, ErrMsg2 ) ! InData_MAP CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -27846,7 +43409,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MeshUnpack( OutData%u_ED_PlatformPtMesh_2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_ED_PlatformPtMesh_2 + CALL MAP_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_MAP, ErrStat2, ErrMsg2 ) ! OutData_MAP CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -27886,7 +43449,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MeshUnpack( OutData%u_SD_TPMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_SD_TPMesh + CALL FEAM_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_FEAM, ErrStat2, ErrMsg2 ) ! InData_FEAM CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -27926,7 +43489,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MeshUnpack( OutData%u_SD_LMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_SD_LMesh + CALL FEAM_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_FEAM, ErrStat2, ErrMsg2 ) ! OutData_FEAM CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -27966,7 +43529,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MeshUnpack( OutData%u_SD_LMesh_2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_SD_LMesh_2 + CALL MD_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_MD, ErrStat2, ErrMsg2 ) ! InData_MD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -28006,7 +43569,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MeshUnpack( OutData%u_HD_M_LumpedMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_HD_M_LumpedMesh + CALL MD_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_MD, ErrStat2, ErrMsg2 ) ! OutData_MD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -28046,7 +43609,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MeshUnpack( OutData%u_HD_M_DistribMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_HD_M_DistribMesh + CALL Orca_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_Orca, ErrStat2, ErrMsg2 ) ! InData_Orca CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -28086,7 +43649,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MeshUnpack( OutData%u_HD_Mesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_HD_Mesh + CALL Orca_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_Orca, ErrStat2, ErrMsg2 ) ! OutData_Orca CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -28126,7 +43689,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MeshUnpack( OutData%u_ED_HubPtLoad, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_ED_HubPtLoad + CALL IceFloe_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_IceF, ErrStat2, ErrMsg2 ) ! InData_IceF CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -28166,27 +43729,13 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MeshUnpack( OutData%u_ED_HubPtLoad_2, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_ED_HubPtLoad_2 + CALL IceFloe_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_IceF, ErrStat2, ErrMsg2 ) ! OutData_IceF CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! u_BD_RootMotion not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%u_BD_RootMotion)) DEALLOCATE(OutData%u_BD_RootMotion) - ALLOCATE(OutData%u_BD_RootMotion(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%u_BD_RootMotion.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%u_BD_RootMotion,1), UBOUND(OutData%u_BD_RootMotion,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -28220,29 +43769,13 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MeshUnpack( OutData%u_BD_RootMotion(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_BD_RootMotion + CALL IceD_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_IceD, ErrStat2, ErrMsg2 ) ! InData_IceD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! y_BD_BldMotion_4Loads not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%y_BD_BldMotion_4Loads)) DEALLOCATE(OutData%y_BD_BldMotion_4Loads) - ALLOCATE(OutData%y_BD_BldMotion_4Loads(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%y_BD_BldMotion_4Loads.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - DO i1 = LBOUND(OutData%y_BD_BldMotion_4Loads,1), UBOUND(OutData%y_BD_BldMotion_4Loads,1) Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -28276,15 +43809,13 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MeshUnpack( OutData%y_BD_BldMotion_4Loads(i1), Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! y_BD_BldMotion_4Loads + CALL IceD_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_IceD, ErrStat2, ErrMsg2 ) ! OutData_IceD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END DO - END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -28318,7 +43849,7 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MeshUnpack( OutData%u_Orca_PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_Orca_PtfmMesh + CALL SC_UnpackInitInput( Re_Buf, Db_Buf, Int_Buf, OutData%InData_SC, ErrStat2, ErrMsg2 ) ! InData_SC CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -28358,18 +43889,18 @@ SUBROUTINE FAST_UnPackModuleMapType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) Int_Xferred = Int_Xferred + Buf_size END IF - CALL MeshUnpack( OutData%u_ExtPtfm_PtfmMesh, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2 ) ! u_ExtPtfm_PtfmMesh + CALL SC_UnpackInitOutput( Re_Buf, Db_Buf, Int_Buf, OutData%OutData_SC, ErrStat2, ErrMsg2 ) ! OutData_SC CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - END SUBROUTINE FAST_UnPackModuleMapType + END SUBROUTINE FAST_UnPackInitData - SUBROUTINE FAST_CopyExternInputType( SrcExternInputTypeData, DstExternInputTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_ExternInputType), INTENT(IN) :: SrcExternInputTypeData - TYPE(FAST_ExternInputType), INTENT(INOUT) :: DstExternInputTypeData + SUBROUTINE FAST_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) + TYPE(FAST_MiscVarType), INTENT(IN) :: SrcMiscData + TYPE(FAST_MiscVarType), INTENT(INOUT) :: DstMiscData INTEGER(IntKi), INTENT(IN ) :: CtrlCode INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg @@ -28378,35 +43909,45 @@ SUBROUTINE FAST_CopyExternInputType( SrcExternInputTypeData, DstExternInputTypeD INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyExternInputType' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyMisc' ! ErrStat = ErrID_None ErrMsg = "" - DstExternInputTypeData%GenTrq = SrcExternInputTypeData%GenTrq - DstExternInputTypeData%ElecPwr = SrcExternInputTypeData%ElecPwr - DstExternInputTypeData%YawPosCom = SrcExternInputTypeData%YawPosCom - DstExternInputTypeData%YawRateCom = SrcExternInputTypeData%YawRateCom - DstExternInputTypeData%BlPitchCom = SrcExternInputTypeData%BlPitchCom - DstExternInputTypeData%HSSBrFrac = SrcExternInputTypeData%HSSBrFrac - DstExternInputTypeData%LidarFocus = SrcExternInputTypeData%LidarFocus - END SUBROUTINE FAST_CopyExternInputType + DstMiscData%TiLstPrn = SrcMiscData%TiLstPrn + DstMiscData%t_global = SrcMiscData%t_global + DstMiscData%NextJacCalcTime = SrcMiscData%NextJacCalcTime + DstMiscData%PrevClockTime = SrcMiscData%PrevClockTime + DstMiscData%UsrTime1 = SrcMiscData%UsrTime1 + DstMiscData%UsrTime2 = SrcMiscData%UsrTime2 + DstMiscData%StrtTime = SrcMiscData%StrtTime + DstMiscData%SimStrtTime = SrcMiscData%SimStrtTime + DstMiscData%calcJacobian = SrcMiscData%calcJacobian + CALL FAST_Copyexterninputtype( SrcMiscData%ExternInput, DstMiscData%ExternInput, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + CALL FAST_Copymisclintype( SrcMiscData%Lin, DstMiscData%Lin, CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + END SUBROUTINE FAST_CopyMisc - SUBROUTINE FAST_DestroyExternInputType( ExternInputTypeData, ErrStat, ErrMsg ) - TYPE(FAST_ExternInputType), INTENT(INOUT) :: ExternInputTypeData + SUBROUTINE FAST_DestroyMisc( MiscData, ErrStat, ErrMsg ) + TYPE(FAST_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyExternInputType' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyMisc' INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 ! ErrStat = ErrID_None ErrMsg = "" - END SUBROUTINE FAST_DestroyExternInputType + CALL FAST_Destroyexterninputtype( MiscData%ExternInput, ErrStat, ErrMsg ) + CALL FAST_Destroymisclintype( MiscData%Lin, ErrStat, ErrMsg ) + END SUBROUTINE FAST_DestroyMisc - SUBROUTINE FAST_PackExternInputType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + SUBROUTINE FAST_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FAST_ExternInputType), INTENT(IN) :: InData + TYPE(FAST_MiscVarType), INTENT(IN) :: InData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly @@ -28421,7 +43962,7 @@ SUBROUTINE FAST_PackExternInputType( 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 = 'FAST_PackExternInputType' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackMisc' ! buffers to store subtypes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -28437,13 +43978,50 @@ SUBROUTINE FAST_PackExternInputType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat Re_BufSz = 0 Db_BufSz = 0 Int_BufSz = 0 - Re_BufSz = Re_BufSz + 1 ! GenTrq - Re_BufSz = Re_BufSz + 1 ! ElecPwr - Re_BufSz = Re_BufSz + 1 ! YawPosCom - Re_BufSz = Re_BufSz + 1 ! YawRateCom - Re_BufSz = Re_BufSz + SIZE(InData%BlPitchCom) ! BlPitchCom - Re_BufSz = Re_BufSz + 1 ! HSSBrFrac - Re_BufSz = Re_BufSz + SIZE(InData%LidarFocus) ! LidarFocus + Db_BufSz = Db_BufSz + 1 ! TiLstPrn + Db_BufSz = Db_BufSz + 1 ! t_global + Db_BufSz = Db_BufSz + 1 ! NextJacCalcTime + Re_BufSz = Re_BufSz + 1 ! PrevClockTime + Re_BufSz = Re_BufSz + 1 ! UsrTime1 + Re_BufSz = Re_BufSz + 1 ! UsrTime2 + Int_BufSz = Int_BufSz + SIZE(InData%StrtTime) ! StrtTime + Int_BufSz = Int_BufSz + SIZE(InData%SimStrtTime) ! SimStrtTime + Int_BufSz = Int_BufSz + 1 ! calcJacobian + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + Int_BufSz = Int_BufSz + 3 ! ExternInput: size of buffers for each call to pack subtype + CALL FAST_Packexterninputtype( Re_Buf, Db_Buf, Int_Buf, InData%ExternInput, ErrStat2, ErrMsg2, .TRUE. ) ! ExternInput + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! ExternInput + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! ExternInput + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! ExternInput + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + Int_BufSz = Int_BufSz + 3 ! Lin: size of buffers for each call to pack subtype + CALL FAST_Packmisclintype( Re_Buf, Db_Buf, Int_Buf, InData%Lin, ErrStat2, ErrMsg2, .TRUE. ) ! Lin + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! Lin + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! Lin + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! Lin + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -28471,27 +44049,91 @@ SUBROUTINE FAST_PackExternInputType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GenTrq - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ElecPwr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawPosCom - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawRateCom - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlPitchCom))-1 ) = PACK(InData%BlPitchCom,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlPitchCom) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HSSBrFrac - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%LidarFocus))-1 ) = PACK(InData%LidarFocus,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%LidarFocus) - END SUBROUTINE FAST_PackExternInputType + DbKiBuf(Db_Xferred) = InData%TiLstPrn + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%t_global + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%NextJacCalcTime + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PrevClockTime + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%UsrTime1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%UsrTime2 + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%StrtTime,1), UBOUND(InData%StrtTime,1) + IntKiBuf(Int_Xferred) = InData%StrtTime(i1) + Int_Xferred = Int_Xferred + 1 + END DO + DO i1 = LBOUND(InData%SimStrtTime,1), UBOUND(InData%SimStrtTime,1) + IntKiBuf(Int_Xferred) = InData%SimStrtTime(i1) + Int_Xferred = Int_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = TRANSFER(InData%calcJacobian, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + CALL FAST_Packexterninputtype( Re_Buf, Db_Buf, Int_Buf, InData%ExternInput, ErrStat2, ErrMsg2, OnlySize ) ! ExternInput + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - SUBROUTINE FAST_UnPackExternInputType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + CALL FAST_Packmisclintype( Re_Buf, Db_Buf, Int_Buf, InData%Lin, ErrStat2, ErrMsg2, OnlySize ) ! Lin + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END SUBROUTINE FAST_PackMisc + + SUBROUTINE FAST_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FAST_ExternInputType), INTENT(INOUT) :: OutData + TYPE(FAST_MiscVarType), INTENT(INOUT) :: OutData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg ! Local variables @@ -28500,16 +44142,10 @@ SUBROUTINE FAST_UnPackExternInputType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackExternInputType' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackMisc' ! buffers to store meshes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -28520,43 +44156,117 @@ SUBROUTINE FAST_UnPackExternInputType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrS Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%GenTrq = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%ElecPwr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawPosCom = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawRateCom = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%BlPitchCom,1) - i1_u = UBOUND(OutData%BlPitchCom,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%BlPitchCom = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlPitchCom))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlPitchCom) - DEALLOCATE(mask1) - OutData%HSSBrFrac = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%LidarFocus,1) - i1_u = UBOUND(OutData%LidarFocus,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%LidarFocus = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%LidarFocus))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%LidarFocus) - DEALLOCATE(mask1) - END SUBROUTINE FAST_UnPackExternInputType + OutData%TiLstPrn = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%t_global = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%NextJacCalcTime = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%PrevClockTime = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%UsrTime1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%UsrTime2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + i1_l = LBOUND(OutData%StrtTime,1) + i1_u = UBOUND(OutData%StrtTime,1) + DO i1 = LBOUND(OutData%StrtTime,1), UBOUND(OutData%StrtTime,1) + OutData%StrtTime(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + i1_l = LBOUND(OutData%SimStrtTime,1) + i1_u = UBOUND(OutData%SimStrtTime,1) + DO i1 = LBOUND(OutData%SimStrtTime,1), UBOUND(OutData%SimStrtTime,1) + OutData%SimStrtTime(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + OutData%calcJacobian = TRANSFER(IntKiBuf(Int_Xferred), OutData%calcJacobian) + Int_Xferred = Int_Xferred + 1 + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL FAST_Unpackexterninputtype( Re_Buf, Db_Buf, Int_Buf, OutData%ExternInput, ErrStat2, ErrMsg2 ) ! ExternInput + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN - SUBROUTINE FAST_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_MiscVarType), INTENT(IN) :: SrcMiscData - TYPE(FAST_MiscVarType), INTENT(INOUT) :: DstMiscData + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL FAST_Unpackmisclintype( Re_Buf, Db_Buf, Int_Buf, OutData%Lin, ErrStat2, ErrMsg2 ) ! Lin + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END SUBROUTINE FAST_UnPackMisc + + SUBROUTINE FAST_CopyExternInitType( SrcExternInitTypeData, DstExternInitTypeData, CtrlCode, ErrStat, ErrMsg ) + TYPE(FAST_ExternInitType), INTENT(IN) :: SrcExternInitTypeData + TYPE(FAST_ExternInitType), INTENT(INOUT) :: DstExternInitTypeData INTEGER(IntKi), INTENT(IN ) :: CtrlCode INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg @@ -28565,42 +44275,42 @@ SUBROUTINE FAST_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyMisc' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyExternInitType' ! ErrStat = ErrID_None ErrMsg = "" - DstMiscData%TiLstPrn = SrcMiscData%TiLstPrn - DstMiscData%t_global = SrcMiscData%t_global - DstMiscData%NextJacCalcTime = SrcMiscData%NextJacCalcTime - DstMiscData%PrevClockTime = SrcMiscData%PrevClockTime - DstMiscData%UsrTime1 = SrcMiscData%UsrTime1 - DstMiscData%UsrTime2 = SrcMiscData%UsrTime2 - DstMiscData%StrtTime = SrcMiscData%StrtTime - DstMiscData%SimStrtTime = SrcMiscData%SimStrtTime - DstMiscData%calcJacobian = SrcMiscData%calcJacobian - CALL FAST_Copyexterninputtype( SrcMiscData%ExternInput, DstMiscData%ExternInput, CtrlCode, ErrStat2, ErrMsg2 ) - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) - IF (ErrStat>=AbortErrLev) RETURN - DstMiscData%NextLinTimeIndx = SrcMiscData%NextLinTimeIndx - END SUBROUTINE FAST_CopyMisc + DstExternInitTypeData%Tmax = SrcExternInitTypeData%Tmax + DstExternInitTypeData%SensorType = SrcExternInitTypeData%SensorType + DstExternInitTypeData%LidRadialVel = SrcExternInitTypeData%LidRadialVel + DstExternInitTypeData%TurbineID = SrcExternInitTypeData%TurbineID + DstExternInitTypeData%TurbinePos = SrcExternInitTypeData%TurbinePos + DstExternInitTypeData%NumSC2Ctrl = SrcExternInitTypeData%NumSC2Ctrl + DstExternInitTypeData%NumCtrl2SC = SrcExternInitTypeData%NumCtrl2SC + DstExternInitTypeData%FarmIntegration = SrcExternInitTypeData%FarmIntegration + DstExternInitTypeData%windGrid_n = SrcExternInitTypeData%windGrid_n + DstExternInitTypeData%windGrid_delta = SrcExternInitTypeData%windGrid_delta + DstExternInitTypeData%windGrid_pZero = SrcExternInitTypeData%windGrid_pZero + DstExternInitTypeData%RootName = SrcExternInitTypeData%RootName + DstExternInitTypeData%NumActForcePtsBlade = SrcExternInitTypeData%NumActForcePtsBlade + DstExternInitTypeData%NumActForcePtsTower = SrcExternInitTypeData%NumActForcePtsTower + END SUBROUTINE FAST_CopyExternInitType - SUBROUTINE FAST_DestroyMisc( MiscData, ErrStat, ErrMsg ) - TYPE(FAST_MiscVarType), INTENT(INOUT) :: MiscData + SUBROUTINE FAST_DestroyExternInitType( ExternInitTypeData, ErrStat, ErrMsg ) + TYPE(FAST_ExternInitType), INTENT(INOUT) :: ExternInitTypeData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyMisc' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyExternInitType' INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 ! ErrStat = ErrID_None ErrMsg = "" - CALL FAST_Destroyexterninputtype( MiscData%ExternInput, ErrStat, ErrMsg ) - END SUBROUTINE FAST_DestroyMisc + END SUBROUTINE FAST_DestroyExternInitType - SUBROUTINE FAST_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) + SUBROUTINE FAST_PackExternInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FAST_MiscVarType), INTENT(IN) :: InData + TYPE(FAST_ExternInitType), INTENT(IN) :: InData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly @@ -28615,7 +44325,7 @@ SUBROUTINE FAST_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackMisc' + CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackExternInitType' ! buffers to store subtypes, if any REAL(ReKi), ALLOCATABLE :: Re_Buf(:) REAL(DbKi), ALLOCATABLE :: Db_Buf(:) @@ -28631,34 +44341,20 @@ SUBROUTINE FAST_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S Re_BufSz = 0 Db_BufSz = 0 Int_BufSz = 0 - Db_BufSz = Db_BufSz + 1 ! TiLstPrn - Db_BufSz = Db_BufSz + 1 ! t_global - Db_BufSz = Db_BufSz + 1 ! NextJacCalcTime - Re_BufSz = Re_BufSz + 1 ! PrevClockTime - Re_BufSz = Re_BufSz + 1 ! UsrTime1 - Re_BufSz = Re_BufSz + 1 ! UsrTime2 - Int_BufSz = Int_BufSz + SIZE(InData%StrtTime) ! StrtTime - Int_BufSz = Int_BufSz + SIZE(InData%SimStrtTime) ! SimStrtTime - Int_BufSz = Int_BufSz + 1 ! calcJacobian - ! Allocate buffers for subtypes, if any (we'll get sizes from these) - Int_BufSz = Int_BufSz + 3 ! ExternInput: size of buffers for each call to pack subtype - CALL FAST_Packexterninputtype( Re_Buf, Db_Buf, Int_Buf, InData%ExternInput, ErrStat2, ErrMsg2, .TRUE. ) ! ExternInput - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN ! ExternInput - Re_BufSz = Re_BufSz + SIZE( Re_Buf ) - DEALLOCATE(Re_Buf) - END IF - IF(ALLOCATED(Db_Buf)) THEN ! ExternInput - Db_BufSz = Db_BufSz + SIZE( Db_Buf ) - DEALLOCATE(Db_Buf) - END IF - IF(ALLOCATED(Int_Buf)) THEN ! ExternInput - Int_BufSz = Int_BufSz + SIZE( Int_Buf ) - DEALLOCATE(Int_Buf) - END IF - Int_BufSz = Int_BufSz + 1 ! NextLinTimeIndx + Db_BufSz = Db_BufSz + 1 ! Tmax + Int_BufSz = Int_BufSz + 1 ! SensorType + Int_BufSz = Int_BufSz + 1 ! LidRadialVel + Int_BufSz = Int_BufSz + 1 ! TurbineID + Re_BufSz = Re_BufSz + SIZE(InData%TurbinePos) ! TurbinePos + Int_BufSz = Int_BufSz + 1 ! NumSC2Ctrl + Int_BufSz = Int_BufSz + 1 ! NumCtrl2SC + Int_BufSz = Int_BufSz + 1 ! FarmIntegration + Int_BufSz = Int_BufSz + SIZE(InData%windGrid_n) ! windGrid_n + Re_BufSz = Re_BufSz + SIZE(InData%windGrid_delta) ! windGrid_delta + Re_BufSz = Re_BufSz + SIZE(InData%windGrid_pZero) ! windGrid_pZero + Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName + Int_BufSz = Int_BufSz + 1 ! NumActForcePtsBlade + Int_BufSz = Int_BufSz + 1 ! NumActForcePtsTower IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -28686,317 +44382,44 @@ SUBROUTINE FAST_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%TiLstPrn - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%t_global - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%NextJacCalcTime - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PrevClockTime - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%UsrTime1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%UsrTime2 - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%StrtTime))-1 ) = PACK(InData%StrtTime,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%StrtTime) - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%SimStrtTime))-1 ) = PACK(InData%SimStrtTime,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%SimStrtTime) - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%calcJacobian , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - CALL FAST_Packexterninputtype( Re_Buf, Db_Buf, Int_Buf, InData%ExternInput, ErrStat2, ErrMsg2, OnlySize ) ! ExternInput - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf - Re_Xferred = Re_Xferred + SIZE(Re_Buf) - DEALLOCATE(Re_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Db_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf - Db_Xferred = Db_Xferred + SIZE(Db_Buf) - DEALLOCATE(Db_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IF(ALLOCATED(Int_Buf)) THEN - IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 - IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf - Int_Xferred = Int_Xferred + SIZE(Int_Buf) - DEALLOCATE(Int_Buf) - ELSE - IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 - ENDIF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NextLinTimeIndx - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FAST_PackMisc - - SUBROUTINE FAST_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) - REAL(ReKi), ALLOCATABLE, INTENT(IN ) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT(IN ) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT(IN ) :: IntKiBuf(:) - TYPE(FAST_MiscVarType), INTENT(INOUT) :: OutData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - ! Local variables - INTEGER(IntKi) :: Buf_size - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackMisc' - ! buffers to store meshes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - OutData%TiLstPrn = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%t_global = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%NextJacCalcTime = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%PrevClockTime = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%UsrTime1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%UsrTime2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - i1_l = LBOUND(OutData%StrtTime,1) - i1_u = UBOUND(OutData%StrtTime,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%StrtTime = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%StrtTime))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%StrtTime) - DEALLOCATE(mask1) - i1_l = LBOUND(OutData%SimStrtTime,1) - i1_u = UBOUND(OutData%SimStrtTime,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%SimStrtTime = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%SimStrtTime))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%SimStrtTime) - DEALLOCATE(mask1) - OutData%calcJacobian = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - Buf_size=IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) - Re_Xferred = Re_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) + DbKiBuf(Db_Xferred) = InData%Tmax + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%SensorType + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%LidRadialVel, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TurbineID + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%TurbinePos,1), UBOUND(InData%TurbinePos,1) + ReKiBuf(Re_Xferred) = InData%TurbinePos(i1) + Re_Xferred = Re_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%NumSC2Ctrl + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumCtrl2SC + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%FarmIntegration, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%windGrid_n,1), UBOUND(InData%windGrid_n,1) + IntKiBuf(Int_Xferred) = InData%windGrid_n(i1) Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) - Db_Xferred = Db_Xferred + Buf_size - END IF - Buf_size=IntKiBuf( Int_Xferred ) + END DO + DO i1 = LBOUND(InData%windGrid_delta,1), UBOUND(InData%windGrid_delta,1) + ReKiBuf(Re_Xferred) = InData%windGrid_delta(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%windGrid_pZero,1), UBOUND(InData%windGrid_pZero,1) + ReKiBuf(Re_Xferred) = InData%windGrid_pZero(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) Int_Xferred = Int_Xferred + 1 - IF(Buf_size > 0) THEN - ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) - Int_Xferred = Int_Xferred + Buf_size - END IF - CALL FAST_Unpackexterninputtype( Re_Buf, Db_Buf, Int_Buf, OutData%ExternInput, ErrStat2, ErrMsg2 ) ! ExternInput - CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - IF (ErrStat >= AbortErrLev) RETURN - - IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) - IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) - IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%NextLinTimeIndx = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - END SUBROUTINE FAST_UnPackMisc - - SUBROUTINE FAST_CopyExternInitType( SrcExternInitTypeData, DstExternInitTypeData, CtrlCode, ErrStat, ErrMsg ) - TYPE(FAST_ExternInitType), INTENT(IN) :: SrcExternInitTypeData - TYPE(FAST_ExternInitType), INTENT(INOUT) :: DstExternInitTypeData - INTEGER(IntKi), INTENT(IN ) :: CtrlCode - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg -! Local - INTEGER(IntKi) :: i,j,k - INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_CopyExternInitType' -! - ErrStat = ErrID_None - ErrMsg = "" - DstExternInitTypeData%Tmax = SrcExternInitTypeData%Tmax - DstExternInitTypeData%SensorType = SrcExternInitTypeData%SensorType - DstExternInitTypeData%LidRadialVel = SrcExternInitTypeData%LidRadialVel - DstExternInitTypeData%TurbineID = SrcExternInitTypeData%TurbineID - DstExternInitTypeData%TurbinePos = SrcExternInitTypeData%TurbinePos - DstExternInitTypeData%NumSC2Ctrl = SrcExternInitTypeData%NumSC2Ctrl - DstExternInitTypeData%NumCtrl2SC = SrcExternInitTypeData%NumCtrl2SC - DstExternInitTypeData%FarmIntegration = SrcExternInitTypeData%FarmIntegration - DstExternInitTypeData%windGrid_n = SrcExternInitTypeData%windGrid_n - DstExternInitTypeData%windGrid_delta = SrcExternInitTypeData%windGrid_delta - DstExternInitTypeData%windGrid_pZero = SrcExternInitTypeData%windGrid_pZero - DstExternInitTypeData%RootName = SrcExternInitTypeData%RootName - DstExternInitTypeData%NumActForcePtsBlade = SrcExternInitTypeData%NumActForcePtsBlade - DstExternInitTypeData%NumActForcePtsTower = SrcExternInitTypeData%NumActForcePtsTower - END SUBROUTINE FAST_CopyExternInitType - - SUBROUTINE FAST_DestroyExternInitType( ExternInitTypeData, ErrStat, ErrMsg ) - TYPE(FAST_ExternInitType), INTENT(INOUT) :: ExternInitTypeData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_DestroyExternInitType' - INTEGER(IntKi) :: i, i1, i2, i3, i4, i5 -! - ErrStat = ErrID_None - ErrMsg = "" - END SUBROUTINE FAST_DestroyExternInitType - - SUBROUTINE FAST_PackExternInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, SizeOnly ) - REAL(ReKi), ALLOCATABLE, INTENT( OUT) :: ReKiBuf(:) - REAL(DbKi), ALLOCATABLE, INTENT( OUT) :: DbKiBuf(:) - INTEGER(IntKi), ALLOCATABLE, INTENT( OUT) :: IntKiBuf(:) - TYPE(FAST_ExternInitType), INTENT(IN) :: InData - INTEGER(IntKi), INTENT( OUT) :: ErrStat - CHARACTER(*), INTENT( OUT) :: ErrMsg - LOGICAL,OPTIONAL, INTENT(IN ) :: SizeOnly - ! Local variables - INTEGER(IntKi) :: Re_BufSz - INTEGER(IntKi) :: Re_Xferred - INTEGER(IntKi) :: Db_BufSz - INTEGER(IntKi) :: Db_Xferred - INTEGER(IntKi) :: Int_BufSz - INTEGER(IntKi) :: Int_Xferred - INTEGER(IntKi) :: i,i1,i2,i3,i4,i5 - LOGICAL :: OnlySize ! if present and true, do not pack, just allocate buffers - INTEGER(IntKi) :: ErrStat2 - CHARACTER(ErrMsgLen) :: ErrMsg2 - CHARACTER(*), PARAMETER :: RoutineName = 'FAST_PackExternInitType' - ! buffers to store subtypes, if any - REAL(ReKi), ALLOCATABLE :: Re_Buf(:) - REAL(DbKi), ALLOCATABLE :: Db_Buf(:) - INTEGER(IntKi), ALLOCATABLE :: Int_Buf(:) - - OnlySize = .FALSE. - IF ( PRESENT(SizeOnly) ) THEN - OnlySize = SizeOnly - ENDIF - ! - ErrStat = ErrID_None - ErrMsg = "" - Re_BufSz = 0 - Db_BufSz = 0 - Int_BufSz = 0 - Db_BufSz = Db_BufSz + 1 ! Tmax - Int_BufSz = Int_BufSz + 1 ! SensorType - Int_BufSz = Int_BufSz + 1 ! LidRadialVel - Int_BufSz = Int_BufSz + 1 ! TurbineID - Re_BufSz = Re_BufSz + SIZE(InData%TurbinePos) ! TurbinePos - Int_BufSz = Int_BufSz + 1 ! NumSC2Ctrl - Int_BufSz = Int_BufSz + 1 ! NumCtrl2SC - Int_BufSz = Int_BufSz + 1 ! FarmIntegration - Int_BufSz = Int_BufSz + SIZE(InData%windGrid_n) ! windGrid_n - Re_BufSz = Re_BufSz + SIZE(InData%windGrid_delta) ! windGrid_delta - Re_BufSz = Re_BufSz + SIZE(InData%windGrid_pZero) ! windGrid_pZero - Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName - Int_BufSz = Int_BufSz + 1 ! NumActForcePtsBlade - Int_BufSz = Int_BufSz + 1 ! NumActForcePtsTower - IF ( Re_BufSz .GT. 0 ) THEN - ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating ReKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Db_BufSz .GT. 0 ) THEN - ALLOCATE( DbKiBuf( Db_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DbKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF ( Int_BufSz .GT. 0 ) THEN - ALLOCATE( IntKiBuf( Int_BufSz ), STAT=ErrStat2 ) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating IntKiBuf.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - IF(OnlySize) RETURN ! return early if only trying to allocate buffers (not pack them) - - Re_Xferred = 1 - Db_Xferred = 1 - Int_Xferred = 1 - - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%Tmax - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%SensorType - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%LidRadialVel , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TurbineID - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TurbinePos))-1 ) = PACK(InData%TurbinePos,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TurbinePos) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumSC2Ctrl - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumCtrl2SC - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%FarmIntegration , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%windGrid_n))-1 ) = PACK(InData%windGrid_n,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%windGrid_n) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%windGrid_delta))-1 ) = PACK(InData%windGrid_delta,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%windGrid_delta) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%windGrid_pZero))-1 ) = PACK(InData%windGrid_pZero,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%windGrid_pZero) - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumActForcePtsBlade - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumActForcePtsTower - Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%NumActForcePtsBlade + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumActForcePtsTower + Int_Xferred = Int_Xferred + 1 END SUBROUTINE FAST_PackExternInitType SUBROUTINE FAST_UnPackExternInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -29012,12 +44435,6 @@ SUBROUTINE FAST_UnPackExternInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -29032,72 +44449,52 @@ SUBROUTINE FAST_UnPackExternInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSt Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%Tmax = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%SensorType = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%LidRadialVel = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%TurbineID = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%Tmax = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%SensorType = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%LidRadialVel = TRANSFER(IntKiBuf(Int_Xferred), OutData%LidRadialVel) + Int_Xferred = Int_Xferred + 1 + OutData%TurbineID = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%TurbinePos,1) i1_u = UBOUND(OutData%TurbinePos,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%TurbinePos = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TurbinePos))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TurbinePos) - DEALLOCATE(mask1) - OutData%NumSC2Ctrl = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumCtrl2SC = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%FarmIntegration = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%TurbinePos,1), UBOUND(OutData%TurbinePos,1) + OutData%TurbinePos(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%NumSC2Ctrl = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumCtrl2SC = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%FarmIntegration = TRANSFER(IntKiBuf(Int_Xferred), OutData%FarmIntegration) + Int_Xferred = Int_Xferred + 1 i1_l = LBOUND(OutData%windGrid_n,1) i1_u = UBOUND(OutData%windGrid_n,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%windGrid_n = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%windGrid_n))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%windGrid_n) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%windGrid_n,1), UBOUND(OutData%windGrid_n,1) + OutData%windGrid_n(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO i1_l = LBOUND(OutData%windGrid_delta,1) i1_u = UBOUND(OutData%windGrid_delta,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%windGrid_delta = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%windGrid_delta))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%windGrid_delta) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%windGrid_delta,1), UBOUND(OutData%windGrid_delta,1) + OutData%windGrid_delta(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%windGrid_pZero,1) i1_u = UBOUND(OutData%windGrid_pZero,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%windGrid_pZero = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%windGrid_pZero))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%windGrid_pZero) - DEALLOCATE(mask1) - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%NumActForcePtsBlade = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumActForcePtsTower = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%windGrid_pZero,1), UBOUND(OutData%windGrid_pZero,1) + OutData%windGrid_pZero(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%NumActForcePtsBlade = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumActForcePtsTower = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE FAST_UnPackExternInitType SUBROUTINE FAST_CopyTurbineType( SrcTurbineTypeData, DstTurbineTypeData, CtrlCode, ErrStat, ErrMsg ) @@ -29633,8 +45030,8 @@ SUBROUTINE FAST_PackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TurbID - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TurbID + Int_Xferred = Int_Xferred + 1 CALL FAST_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%p_FAST, ErrStat2, ErrMsg2, OnlySize ) ! p_FAST CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -30238,12 +45635,6 @@ SUBROUTINE FAST_UnPackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'FAST_UnPackTurbineType' @@ -30257,8 +45648,8 @@ SUBROUTINE FAST_UnPackTurbineType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%TurbID = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%TurbID = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN diff --git a/modules/openfast-registry/src/Makefile b/modules/openfast-registry/src/Makefile deleted file mode 100644 index 921149cd0e..0000000000 --- a/modules/openfast-registry/src/Makefile +++ /dev/null @@ -1,67 +0,0 @@ -ifeq ($(OS),Windows_NT) - ifeq ($(OSTYPE),cygwin) - RM=rm -f - else - RM=del - endif -else - RM = rm -f -endif -.SUFFIXES: .c .o - -# i586-mingw32msvc-gcc -#CC_TOOLS = i586-mingw32msvc-gcc -CC_TOOLS = gcc -DEST_DIR = .. -CFLAGS = #-ansi -LDFLAGS = -DEBUG = -g -OBJ = registry.o \ - my_strtok.o \ - reg_parse.o \ - data.o \ - type.o \ - misc.o \ - sym.o \ - symtab_gen.o \ - gen_module_files.o \ - gen_c_types.o - -# marco's: all : $(OBJ) -$(DEST_DIR)/registry.exe : $(OBJ) - $(CC_TOOLS) -o $(DEST_DIR)/registry.exe $(DEBUG) $(LDFLAGS) $(OBJ) - -.c.o : - $(CC_TOOLS) $(CFLAGS) -c $(DEBUG) $< - -clean clena: - $(RM) $(OBJ) gen_comms.c standard.o - -superclean : clean - $(RM) $(DEST_DIR)/registry.exe Registry_tmp.* - -# regenerate this list with "makedepend -Y *.c" - -# DO NOT DELETE THIS LINE -- make depend depends on it. - -gen_module_files.o: protos.h registry.h data.h FAST_preamble.h type.o - -data.o: registry.h protos.h data.h -gen_allocs.o: protos.h registry.h data.h -gen_args.o: protos.h registry.h data.h -gen_scalar_derefs.o: protos.h registry.h data.h -gen_config.o: protos.h registry.h data.h -gen_defs.o: protos.h registry.h data.h -gen_mod_state_descr.o: protos.h registry.h data.h -gen_model_data_ord.o: protos.h registry.h data.h -gen_scalar_indices.o: protos.h registry.h data.h -gen_wrf_io.o: protos.h registry.h data.h -misc.o: protos.h registry.h data.h -my_strtok.o: registry.h protos.h data.h -reg_parse.o: registry.h protos.h data.h -registry.o: protos.h registry.h data.h Template_data.c Template_registry.c -sym.o: sym.h -type.o: registry.h protos.h data.h -gen_interp.o: registry.h protos.h data.h -gen_streams.o: registry.h protos.h data.h -gen_c_types.o: registry.h protos.h data.h diff --git a/modules/openfast-registry/src/data.h b/modules/openfast-registry/src/data.h index 80c0101bd9..bc81980c73 100644 --- a/modules/openfast-registry/src/data.h +++ b/modules/openfast-registry/src/data.h @@ -37,7 +37,7 @@ typedef struct node_struct { /* CTRL */ - int gen_wrapper ; + int gen_periodic ; struct node_struct * next ; /* fields used by rconfig nodes */ diff --git a/modules/openfast-registry/src/gen_c_types.c b/modules/openfast-registry/src/gen_c_types.c index 1e329624ce..74bd14d662 100644 --- a/modules/openfast-registry/src/gen_c_types.c +++ b/modules/openfast-registry/src/gen_c_types.c @@ -377,7 +377,10 @@ gen_c_module( FILE * fph, node_t * ModName ) fprintf(fph," %s * %s ; ",C_type( r->type->mapsto), r->name ) ; fprintf(fph," int %s_Len ;",r->name ) ; } else { - char *p = r->type->mapsto, buf[10]; + char *p = r->type->mapsto; + char buf[10]; +// bjj: this assumes all character strings are defined with numeric lengths +// It should be modified to allow use of parameters, too. (and parameters defined in the registry should also be defined in the .h file) while (*p) { if (isdigit(*p)) { long val = strtol(p, &p, 10); @@ -385,6 +388,8 @@ gen_c_module( FILE * fph, node_t * ModName ) } else { p++; } + + } if (strcmp(C_type(r->type->mapsto), "char") == 0 ){ // if it's a char we need to add the array size if (r->ndims == 0) diff --git a/modules/openfast-registry/src/gen_module_files.c b/modules/openfast-registry/src/gen_module_files.c index 84f912c9ba..7e44d315f6 100644 --- a/modules/openfast-registry/src/gen_module_files.c +++ b/modules/openfast-registry/src/gen_module_files.c @@ -33,13 +33,20 @@ gen_copy_c2f( FILE *fp , // *.f90 file we are writting to remove_nickname(ModName->nickname,inout,nonick) ; append_nickname((is_a_fast_interface_type(inoutlong))?ModName->nickname:"",inoutlong,addnick) ; - fprintf(fp," SUBROUTINE %s_C2Fary_Copy%s( %sData, ErrStat, ErrMsg )\n", ModName->nickname, nonick,nonick ); + fprintf(fp," SUBROUTINE %s_C2Fary_Copy%s( %sData, ErrStat, ErrMsg, SkipPointers )\n", ModName->nickname, nonick,nonick ); fprintf(fp," TYPE(%s), INTENT(INOUT) :: %sData\n" , addnick, nonick ); fprintf(fp," INTEGER(IntKi), INTENT( OUT) :: ErrStat\n" ); fprintf(fp," CHARACTER(*), INTENT( OUT) :: ErrMsg\n" ); + fprintf(fp," LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers\n" ); fprintf(fp," ! \n" ); + fprintf(fp," LOGICAL :: SkipPointers_local\n"); fprintf(fp," ErrStat = ErrID_None\n" ); - fprintf(fp," ErrMsg = \"\"\n" ); + fprintf(fp," ErrMsg = \"\"\n\n" ); + fprintf(fp," IF (PRESENT(SkipPointers)) THEN\n"); + fprintf(fp," SkipPointers_local = SkipPointers\n"); + fprintf(fp," ELSE\n"); + fprintf(fp," SkipPointers_local = .false.\n"); + fprintf(fp," END IF\n"); sprintf(tmp,"%s",addnick) ; @@ -55,11 +62,13 @@ gen_copy_c2f( FILE *fp , // *.f90 file we are writting to } else { if ( is_pointer(r) ) { fprintf(fp,"\n ! -- %s %s Data fields\n",r->name,nonick) ; - fprintf(fp," IF ( .NOT. C_ASSOCIATED( %sData%%C_obj%%%s ) ) THEN\n",nonick,r->name) ; - fprintf(fp," NULLIFY( %sData%%%s )\n",nonick,r->name) ; - fprintf(fp," ELSE\n") ; - fprintf(fp," CALL C_F_POINTER(%sData%%C_obj%%%s, %sData%%%s, (/%sData%%C_obj%%%s_Len/))\n",nonick,r->name,nonick,r->name,nonick,r->name) ; - fprintf(fp," END IF\n") ; + fprintf(fp," IF ( .NOT. SkipPointers_local ) THEN\n"); + fprintf(fp," IF ( .NOT. C_ASSOCIATED( %sData%%C_obj%%%s ) ) THEN\n",nonick,r->name) ; + fprintf(fp," NULLIFY( %sData%%%s )\n",nonick,r->name) ; + fprintf(fp," ELSE\n") ; + fprintf(fp," CALL C_F_POINTER(%sData%%C_obj%%%s, %sData%%%s, (/%sData%%C_obj%%%s_Len/))\n",nonick,r->name,nonick,r->name,nonick,r->name) ; + fprintf(fp," END IF\n") ; + fprintf(fp, " END IF\n"); } else if (!has_deferred_dim(r, 0)) { if (!strcmp(r->type->mapsto, "REAL(ReKi)") || @@ -86,6 +95,87 @@ gen_copy_c2f( FILE *fp , // *.f90 file we are writting to return(0) ; } +int +gen_copy_f2c(FILE *fp, // *.f90 file we are writting to + const node_t *ModName, // module name + char *inout, // character string written out + char *inoutlong) // not sure what this is used for +{ + node_t *q, *r; + char tmp[NAMELEN]; + char addnick[NAMELEN]; + char nonick[NAMELEN]; + + remove_nickname(ModName->nickname, inout, nonick); + append_nickname((is_a_fast_interface_type(inoutlong)) ? ModName->nickname : "", inoutlong, addnick); + fprintf(fp, " SUBROUTINE %s_F2C_Copy%s( %sData, ErrStat, ErrMsg, SkipPointers )\n", ModName->nickname, nonick, nonick); + fprintf(fp, " TYPE(%s), INTENT(INOUT) :: %sData\n", addnick, nonick); + fprintf(fp, " INTEGER(IntKi), INTENT( OUT) :: ErrStat\n"); + fprintf(fp, " CHARACTER(*), INTENT( OUT) :: ErrMsg\n"); + fprintf(fp, " LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers\n"); + fprintf(fp, " ! \n"); + fprintf(fp, " LOGICAL :: SkipPointers_local\n"); + fprintf(fp, " ErrStat = ErrID_None\n"); + fprintf(fp, " ErrMsg = \"\"\n\n"); + fprintf(fp, " IF (PRESENT(SkipPointers)) THEN\n"); + fprintf(fp, " SkipPointers_local = SkipPointers\n"); + fprintf(fp, " ELSE\n"); + fprintf(fp, " SkipPointers_local = .false.\n"); + fprintf(fp, " END IF\n"); + + sprintf(tmp, "%s", addnick); + + if ((q = get_entry(make_lower_temp(tmp), ModName->module_ddt_list)) == NULL) + { + fprintf(stderr, "Registry warning: generating %s_F2C_Copy%s: cannot find definition for %s\n", ModName->nickname, nonick, tmp); + } + else { + for (r = q->fields; r; r = r->next) + { + if (r->type != NULL) { + if (r->type->type_type == DERIVED) { // && ! r->type->usefrom + fprintf(stderr, "Registry WARNING: derived data type %s of type %s is not passed through F-C interface\n", r->name, r->type->name); + } + else { + if (is_pointer(r)) { + fprintf(fp, "\n ! -- %s %s Data fields\n", r->name, nonick); + fprintf(fp, " IF ( .NOT. SkipPointers_local ) THEN\n"); + fprintf(fp, " IF ( .NOT. %s(%sData%%%s)) THEN \n", assoc_or_allocated(r), nonick, r->name); + fprintf(fp, " %sData%%c_obj%%%s_Len = 0\n", nonick, r->name); + fprintf(fp, " %sData%%c_obj%%%s = C_NULL_PTR\n", nonick, r->name); + fprintf(fp, " ELSE\n"); + fprintf(fp, " %sData%%c_obj%%%s_Len = SIZE(%sData%%%s)\n", nonick, r->name, nonick, r->name); + fprintf(fp, " IF (%sData%%c_obj%%%s_Len > 0) &\n", nonick, r->name); + fprintf(fp, " %sData%%c_obj%%%s = C_LOC( %sData%%%s( LBOUND(%sData%%%s,1) ) ) \n", nonick, r->name, nonick, r->name, nonick, r->name ); + fprintf(fp, " END IF\n"); + fprintf(fp, " END IF\n"); + } + else if (!has_deferred_dim(r, 0)) { + if (!strcmp(r->type->mapsto, "REAL(ReKi)") || + !strcmp(r->type->mapsto, "REAL(SiKi)") || + !strcmp(r->type->mapsto, "REAL(DbKi)") || + !strcmp(r->type->mapsto, "REAL(R8Ki)") || + !strcmp(r->type->mapsto, "INTEGER(IntKi)") || + !strcmp(r->type->mapsto, "LOGICAL")) + { + fprintf(fp, " %sData%%C_obj%%%s = %sData%%%s\n", nonick, r->name, nonick, r->name); + } + else { // characters need to be copied differently + if (r->ndims == 0) { + //fprintf(stderr, "Registry WARNING: character data type %s of type %s is not passed through F-C interface\n", r->name, r->type->name); + fprintf(fp, " %sData%%C_obj%%%s = TRANSFER(%sData%%%s, %sData%%C_obj%%%s )\n", nonick, r->name, nonick, r->name, nonick, r->name); + } + } + } + } + } + } + } + + fprintf(fp, " END SUBROUTINE %s_F2C_Copy%s\n\n", ModName->nickname, nonick); + return(0); +} + int gen_copy( FILE * fp, const node_t * ModName, char * inout, char * inoutlong, const node_t * q_in ) @@ -190,13 +280,14 @@ gen_copy( FILE * fp, const node_t * ModName, char * inout, char * inoutlong, con fprintf(fp, " Dst%sData%%%s = Src%sData%%%s\n",nonick,r->name,nonick,r->name) ; if (sw_ccode && !is_pointer(r)){ - if (!strcmp(r->type->mapsto, "REAL(ReKi)") || - !strcmp(r->type->mapsto, "REAL(SiKi)") || - !strcmp(r->type->mapsto, "REAL(DbKi)") || - !strcmp(r->type->mapsto, "REAL(R8Ki)") || - !strcmp(r->type->mapsto, "INTEGER(IntKi)") || - !strcmp(r->type->mapsto, "LOGICAL") || - r->ndims == 0) + //if (!strcmp(r->type->mapsto, "REAL(ReKi)") || + // !strcmp(r->type->mapsto, "REAL(SiKi)") || + // !strcmp(r->type->mapsto, "REAL(DbKi)") || + // !strcmp(r->type->mapsto, "REAL(R8Ki)") || + // !strcmp(r->type->mapsto, "INTEGER(IntKi)") || + // !strcmp(r->type->mapsto, "LOGICAL") || + // r->ndims == 0) + if ( r->ndims == 0 ) // scalar of any type OR a character array { // fprintf(fp, " Dst%sData%%C_obj%%%s = Dst%sData%%%s\n", nonick, r->name, nonick, r->name); fprintf(fp, " Dst%sData%%C_obj%%%s = Src%sData%%C_obj%%%s\n", nonick, r->name, nonick, r->name); @@ -221,10 +312,10 @@ void gen_pack( FILE * fp, const node_t * ModName, char * inout, char *inoutlong ) { - char tmp[NAMELEN], tmp2[NAMELEN], tmp3[NAMELEN], addnick[NAMELEN], nonick[NAMELEN] ; - char nonick2[NAMELEN]; + char tmp[NAMELEN], tmp2[NAMELEN], addnick[NAMELEN], nonick[NAMELEN] ; + char nonick2[NAMELEN], indent[NAMELEN], mainIndent[6]; node_t *q, * r ; - int frst, d; + int frst, d, i; remove_nickname(ModName->nickname,inout,nonick) ; append_nickname((is_a_fast_interface_type(inoutlong))?ModName->nickname:"",inoutlong,addnick) ; @@ -416,26 +507,26 @@ gen_pack( FILE * fp, const node_t * ModName, char * inout, char *inoutlong ) for ( r = q->fields ; r ; r = r->next ) { - if (has_deferred_dim(r, 0)){ - // store whether the data type is allocated and the bounds of each dimension - fprintf(fp, " IF ( .NOT. %s(InData%%%s) ) THEN\n", assoc_or_allocated(r), r->name); - fprintf(fp, " IntKiBuf( Int_Xferred ) = 0\n"); // not allocated - fprintf(fp, " Int_Xferred = Int_Xferred + 1\n"); - //fprintf(fp, " IntKiBuf( Int_Xferred:Int_Xferred+2*%d-1 ) = 0\n", r->ndims, r->name); - //fprintf(fp, " Int_Xferred = Int_Xferred + 2*%d\n", r->ndims); - fprintf(fp, " ELSE\n"); - fprintf(fp, " IntKiBuf( Int_Xferred ) = 1\n"); // allocated - fprintf(fp, " Int_Xferred = Int_Xferred + 1\n"); - for (d = 1; d <= r->ndims; d++) { - fprintf(fp, " IntKiBuf( Int_Xferred ) = LBOUND(InData%%%s,%d)\n", r->name, d); - fprintf(fp, " IntKiBuf( Int_Xferred + 1) = UBOUND(InData%%%s,%d)\n", r->name, d); - fprintf(fp, " Int_Xferred = Int_Xferred + 2\n"); - } - fprintf(fp, "\n"); - sprintf(tmp3, " IF (SIZE(InData%%%s)>0)", r->name); - } - else{ - sprintf(tmp3, " "); + if (has_deferred_dim(r, 0)) { + // store whether the data type is allocated and the bounds of each dimension + fprintf(fp, " IF ( .NOT. %s(InData%%%s) ) THEN\n", assoc_or_allocated(r), r->name); + fprintf(fp, " IntKiBuf( Int_Xferred ) = 0\n"); // not allocated + fprintf(fp, " Int_Xferred = Int_Xferred + 1\n"); + //fprintf(fp, " IntKiBuf( Int_Xferred:Int_Xferred+2*%d-1 ) = 0\n", r->ndims, r->name); + //fprintf(fp, " Int_Xferred = Int_Xferred + 2*%d\n", r->ndims); + fprintf(fp, " ELSE\n"); + fprintf(fp, " IntKiBuf( Int_Xferred ) = 1\n"); // allocated + fprintf(fp, " Int_Xferred = Int_Xferred + 1\n"); + for (d = 1; d <= r->ndims; d++) { + fprintf(fp, " IntKiBuf( Int_Xferred ) = LBOUND(InData%%%s,%d)\n", r->name, d); + fprintf(fp, " IntKiBuf( Int_Xferred + 1) = UBOUND(InData%%%s,%d)\n", r->name, d); + fprintf(fp, " Int_Xferred = Int_Xferred + 2\n"); + } + fprintf(fp, "\n"); + strcpy(mainIndent, " "); + } + else { + strcpy(mainIndent, ""); } @@ -500,63 +591,55 @@ gen_pack( FILE * fp, const node_t * ModName, char * inout, char *inoutlong ) } } - else { // intrinsic data types + else { + // intrinsic data types // do all dimensions of arrays (no need for loop over i%d) - sprintf(tmp2, "SIZE(InData%%%s)", r->name); + strcpy(indent, " "); + strcat(indent, mainIndent); + for (d = r->ndims; d >= 1; d--) { + fprintf(fp, "%s DO i%d = LBOUND(InData%%%s,%d), UBOUND(InData%%%s,%d)\n", indent, d, r->name, d, r->name, d); + strcat(indent, " "); //create an indent + } + if (!strcmp(r->type->mapsto, "REAL(ReKi)") || !strcmp(r->type->mapsto, "REAL(SiKi)")) { - fprintf(fp, " %s ReKiBuf ( Re_Xferred:Re_Xferred+(%s)-1 ) = %sInData%%%s%s\n", - tmp3, (r->ndims>0) ? tmp2 : "1", (r->ndims>0) ? "PACK(" : "", r->name, (r->ndims>0) ? ",.TRUE.)" : ""); - fprintf(fp, " Re_Xferred = Re_Xferred + %s\n", (r->ndims>0) ? tmp2 : "1"); + fprintf(fp, "%s ReKiBuf(Re_Xferred) = InData%%%s%s\n", indent, r->name, dimstr(r->ndims)); + fprintf(fp, "%s Re_Xferred = Re_Xferred + 1\n", indent); } else if (!strcmp(r->type->mapsto, "REAL(DbKi)") || !strcmp(r->type->mapsto, "REAL(R8Ki)")) { - fprintf(fp, " %s DbKiBuf ( Db_Xferred:Db_Xferred+(%s)-1 ) = %sInData%%%s%s\n", - tmp3, (r->ndims>0) ? tmp2 : "1", (r->ndims>0) ? "PACK(" : "", r->name, (r->ndims>0) ? ",.TRUE.)" : ""); - fprintf(fp, " Db_Xferred = Db_Xferred + %s\n", (r->ndims>0) ? tmp2 : "1"); + fprintf(fp, "%s DbKiBuf(Db_Xferred) = InData%%%s%s\n", indent, r->name, dimstr(r->ndims)); + fprintf(fp, "%s Db_Xferred = Db_Xferred + 1\n", indent); } else if (!strcmp(r->type->mapsto, "INTEGER(IntKi)") ) { - fprintf(fp, " %s IntKiBuf ( Int_Xferred:Int_Xferred+(%s)-1 ) = %sInData%%%s%s\n", - tmp3, (r->ndims>0) ? tmp2 : "1", (r->ndims>0) ? "PACK(" : "", r->name, (r->ndims>0) ? ",.TRUE.)" : ""); - fprintf(fp, " Int_Xferred = Int_Xferred + %s\n", (r->ndims>0) ? tmp2 : "1"); + fprintf(fp, "%s IntKiBuf(Int_Xferred) = InData%%%s%s\n", indent, r->name, dimstr(r->ndims)); + fprintf(fp, "%s Int_Xferred = Int_Xferred + 1\n", indent); } else if (!strcmp(r->type->mapsto, "LOGICAL") ) { - fprintf(fp, " %s IntKiBuf ( Int_Xferred:Int_Xferred+%s-1 ) = TRANSFER(%s InData%%%s %s, IntKiBuf(1), %s)\n", - tmp3, (r->ndims>0) ? tmp2 : "1", (r->ndims>0) ? "PACK(" : "", r->name, (r->ndims>0) ? ",.TRUE.)" : "", - (r->ndims>0) ? tmp2 : "1"); - fprintf(fp, " Int_Xferred = Int_Xferred + %s\n", (r->ndims>0) ? tmp2 : "1"); + fprintf(fp, "%s IntKiBuf(Int_Xferred) = TRANSFER(InData%%%s%s, IntKiBuf(1))\n", indent, r->name, dimstr(r->ndims)); + fprintf(fp, "%s Int_Xferred = Int_Xferred + 1\n", indent); } else /*if (!strcmp(r->type->mapsto, "CHARACTER")) */{ - for (d = r->ndims; d >= 1; d--) { - fprintf(fp, " DO i%d = LBOUND(InData%%%s,%d), UBOUND(InData%%%s,%d)\n", d, r->name, d, r->name, d); - } + fprintf(fp, "%s DO I = 1, LEN(InData%%%s)\n", indent, r->name); + fprintf(fp, "%s IntKiBuf(Int_Xferred) = ICHAR(InData%%%s%s(I:I), IntKi)\n", indent, r->name, dimstr(r->ndims)); + fprintf(fp, "%s Int_Xferred = Int_Xferred + 1\n", indent); + fprintf(fp, "%s END DO ! I\n", indent); - fprintf(fp, " DO I = 1, LEN(InData%%%s)\n", r->name); - fprintf(fp, " IntKiBuf(Int_Xferred) = ICHAR(InData%%%s%s(I:I), IntKi)\n", r->name, dimstr(r->ndims)); - fprintf(fp, " Int_Xferred = Int_Xferred + 1\n"); - fprintf(fp, " END DO ! I\n"); + } - for (d = r->ndims; d >= 1; d--) { - fprintf(fp, " END DO !i%d\n",d); + for (d = r->ndims; d >= 1; d--) { + strcpy(indent, " "); + strcat(indent, mainIndent); + for (i = 1; i < d; i++) { + strcat(indent, " "); } + fprintf(fp, "%s END DO\n", indent); + } -// bjj: this works, but will produce errors about the source being smaller than the result, thus leaving garbage in some bytes -#if 0 - fprintf(fp, " IntKiBuf ( Int_Xferred:Int_Xferred+%s*LEN(InData%%%s)-1 ) = TRANSFER(%s InData%%%s %s, IntKiBuf(1), %s*LEN(InData%%%s))\n", - (r->ndims>0) ? tmp2 : "1", r->name, - (r->ndims>0) ? "PACK(" : "", r->name, (r->ndims>0) ? ",.TRUE.)" : "", - (r->ndims>0) ? tmp2 : "1", r->name); - fprintf(fp, " Int_Xferred = Int_Xferred + %s*LEN(InData%%%s)\n", (r->ndims>0) ? tmp2 : "1", r->name); -#endif - } /* - else - { - fprintf(fp, "! missing buffer for %s\n", r->name); - }*/ } if (has_deferred_dim(r, 0)){ @@ -571,9 +654,9 @@ gen_pack( FILE * fp, const node_t * ModName, char * inout, char *inoutlong ) void gen_unpack( FILE * fp, const node_t * ModName, char * inout, char * inoutlong ) { - char tmp[NAMELEN], tmp2[NAMELEN], tmp3[NAMELEN], addnick[NAMELEN], nonick[NAMELEN], nonick2[NAMELEN]; + char tmp[NAMELEN], tmp2[NAMELEN], indent[NAMELEN], addnick[NAMELEN], nonick[NAMELEN], nonick2[NAMELEN], mainIndent[6]; node_t *q, * r ; - int d ; + int d, i ; remove_nickname(ModName->nickname,inout,nonick) ; append_nickname((is_a_fast_interface_type(inoutlong))?ModName->nickname:"",inoutlong,addnick) ; @@ -599,12 +682,6 @@ gen_unpack( FILE * fp, const node_t * ModName, char * inout, char * inoutlong ) fprintf(fp," INTEGER(IntKi) :: Db_Xferred\n") ; fprintf(fp," INTEGER(IntKi) :: Int_Xferred\n") ; fprintf(fp," INTEGER(IntKi) :: i\n") ; - fprintf(fp," LOGICAL :: mask0\n"); - fprintf(fp," LOGICAL, ALLOCATABLE :: mask1(:)\n"); - fprintf(fp," LOGICAL, ALLOCATABLE :: mask2(:,:)\n"); - fprintf(fp," LOGICAL, ALLOCATABLE :: mask3(:,:,:)\n") ; - fprintf(fp," LOGICAL, ALLOCATABLE :: mask4(:,:,:,:)\n") ; - fprintf(fp," LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:)\n") ; for (d = 1; d <= q->max_ndims; d++){ fprintf(fp," INTEGER(IntKi) :: i%d, i%d_l, i%d_u ! bounds (upper/lower) for an array dimension %d\n", d, d, d, d); } @@ -659,18 +736,16 @@ gen_unpack( FILE * fp, const node_t * ModName, char * inout, char * inoutlong ) fprintf(fp, " IF (OutData%%c_obj%%%s_Len > 0) &\n", r->name); fprintf(fp, " OutData%%c_obj%%%s = C_LOC( OutData%%%s(i1_l) ) \n", r->name, r->name); } - - sprintf(tmp3, " IF (SIZE(OutData%%%s)>0)", r->name); + strcpy(mainIndent, " "); } else{ - sprintf(tmp3, " "); - for (d = 1; d <= r->ndims; d++) { fprintf(fp, " i%d_l = LBOUND(OutData%%%s,%d)\n", d, r->name, d); fprintf(fp, " i%d_u = UBOUND(OutData%%%s,%d)\n", d, r->name, d); sprintf(tmp2, ",i%d_l:i%d_u", d, d); strcat(tmp, tmp2); } + strcpy(mainIndent, ""); } if (!strcmp(r->type->name, "meshtype") || @@ -751,122 +826,73 @@ gen_unpack( FILE * fp, const node_t * ModName, char * inout, char * inoutlong ) } } - else if (r->ndims > 0){ //non-scalar intrinsic data types (arrays) - fprintf(fp, " ALLOCATE(mask%d(%s),STAT=ErrStat2)\n", r->ndims, (char*)&(tmp[1])); - fprintf(fp, " IF (ErrStat2 /= 0) THEN \n"); - fprintf(fp, " CALL SetErrStat(ErrID_Fatal, 'Error allocating mask%d.', ErrStat, ErrMsg,RoutineName)\n", r->ndims); - fprintf(fp, " RETURN\n"); - fprintf(fp, " END IF\n"); - fprintf(fp, " mask%d = .TRUE. \n", r->ndims); + else + { + strcpy(indent, " "); + strcat(indent, mainIndent); + for (d = r->ndims; d >= 1; d--) { + fprintf(fp, "%s DO i%d = LBOUND(OutData%%%s,%d), UBOUND(OutData%%%s,%d)\n", indent, d, r->name, d, r->name, d); + strcat(indent, " "); //create an indent + } - // do all dimensions of arrays (no need for loop over i%d) - sprintf(tmp2, "SIZE(OutData%%%s)", r->name); - if (!strcmp(r->type->mapsto, "REAL(ReKi)")) { - if (is_pointer(r)) { // bjj: this isn't very generic, but it's quick and will work for all current cases - fprintf(fp, " %s OutData%%%s = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(%s)-1 ), mask%d, 0.0_ReKi ), C_FLOAT)\n", - tmp3, r->name, tmp2, r->ndims); + if (!strcmp(r->type->mapsto, "REAL(ReKi)") || + !strcmp(r->type->mapsto, "REAL(SiKi)")) { + if (sw_ccode && is_pointer(r)) { + fprintf(fp, "%s OutData%%%s%s = REAL(ReKiBuf(Re_Xferred), C_FLOAT)\n", indent, r->name, dimstr(r->ndims)); + } + else if (!strcmp(r->type->mapsto, "REAL(SiKi)")) { + fprintf(fp, "%s OutData%%%s%s = REAL(ReKiBuf(Re_Xferred), SiKi)\n", indent, r->name, dimstr(r->ndims)); } else { - fprintf(fp, " %s OutData%%%s = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(%s)-1 ), mask%d, 0.0_ReKi )\n", - tmp3, r->name, tmp2, r->ndims); + fprintf(fp, "%s OutData%%%s%s = ReKiBuf(Re_Xferred)\n", indent, r->name, dimstr(r->ndims)); } - fprintf(fp, " Re_Xferred = Re_Xferred + %s\n", tmp2); + fprintf(fp, "%s Re_Xferred = Re_Xferred + 1\n", indent); } - else if (!strcmp(r->type->mapsto, "REAL(SiKi)")) - { - fprintf(fp, " %s OutData%%%s = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(%s)-1 ), mask%d, 0.0_ReKi ), SiKi)\n", - tmp3, r->name, tmp2, r->ndims); - fprintf(fp, " Re_Xferred = Re_Xferred + %s\n", tmp2); - } - else if (!strcmp(r->type->mapsto, "REAL(DbKi)")) { - if (is_pointer(r)) { // bjj: this isn't very generic, but it's quick and will work for all current cases - fprintf(fp, " %s OutData%%%s = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(%s)-1 ), mask%d, 0.0_DbKi ), C_DOUBLE)\n", - tmp3, r->name, tmp2, r->ndims); + else if (!strcmp(r->type->mapsto, "REAL(DbKi)") || + !strcmp(r->type->mapsto, "REAL(R8Ki)")) { + if (sw_ccode && is_pointer(r)) { + fprintf(fp, "%s OutData%%%s%s = REAL(DbKiBuf(Db_Xferred), C_DOUBLE)\n", indent, r->name, dimstr(r->ndims)); + } + else if (!strcmp(r->type->mapsto, "REAL(R8Ki)")) { + fprintf(fp, "%s OutData%%%s%s = REAL(DbKiBuf(Db_Xferred), R8Ki)\n", indent, r->name, dimstr(r->ndims)); } else { - fprintf(fp, " %s OutData%%%s = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(%s)-1 ), mask%d, 0.0_DbKi )\n", - tmp3, r->name, (r->ndims > 0) ? tmp2 : "1", r->ndims); + fprintf(fp, "%s OutData%%%s%s = DbKiBuf(Db_Xferred)\n", indent, r->name, dimstr(r->ndims)); } - fprintf(fp, " Db_Xferred = Db_Xferred + %s\n", tmp2); - } - else if (!strcmp(r->type->mapsto, "REAL(R8Ki)")) - { - fprintf(fp, " %s OutData%%%s = REAL( UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(%s)-1 ), mask%d, 0.0_DbKi ), R8Ki)\n", - tmp3, r->name, tmp2, r->ndims); - fprintf(fp, " Db_Xferred = Db_Xferred + %s\n", tmp2); + fprintf(fp, "%s Db_Xferred = Db_Xferred + 1\n", indent); } else if (!strcmp(r->type->mapsto, "INTEGER(IntKi)")) { - fprintf(fp, " %s OutData%%%s = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(%s)-1 ), mask%d, 0_IntKi )\n", - tmp3, r->name, (r->ndims>0) ? tmp2 : "1", r->ndims); - fprintf(fp, " Int_Xferred = Int_Xferred + %s\n", tmp2); + fprintf(fp, "%s OutData%%%s%s = IntKiBuf(Int_Xferred)\n", indent, r->name, dimstr(r->ndims)); + fprintf(fp, "%s Int_Xferred = Int_Xferred + 1\n", indent); } else if (!strcmp(r->type->mapsto, "LOGICAL")) { - //fprintf(fp, " %s OutData%%%s = TRANSFER( UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(%s)-1 ), mask%d, 0 ), OutData%%%s)\n", - fprintf(fp, " %s OutData%%%s = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(%s)-1 ), OutData%%%s), mask%d,.TRUE.)\n", - tmp3, r->name, (r->ndims>0) ? tmp2 : "1", r->name, r->ndims); - fprintf(fp, " Int_Xferred = Int_Xferred + %s\n", tmp2); + fprintf(fp, "%s OutData%%%s%s = TRANSFER(IntKiBuf(Int_Xferred), OutData%%%s%s)\n", indent, r->name, dimstr(r->ndims), r->name, dimstr(r->ndims)); + fprintf(fp, "%s Int_Xferred = Int_Xferred + 1\n", indent); } - else /*if (!strcmp(r->type->mapsto, "CHARACTER")) */{ - - for (d = r->ndims; d >= 1; d--) { - fprintf(fp, " DO i%d = LBOUND(OutData%%%s,%d), UBOUND(OutData%%%s,%d)\n", d, r->name, d, r->name, d); - } + else /*if (!strcmp(r->type->mapsto, "CHARACTER")) */ { - fprintf(fp, " DO I = 1, LEN(OutData%%%s)\n", r->name); - fprintf(fp, " OutData%%%s%s(I:I) = CHAR(IntKiBuf(Int_Xferred))\n", r->name, dimstr(r->ndims)); - fprintf(fp, " Int_Xferred = Int_Xferred + 1\n"); - fprintf(fp, " END DO ! I\n"); + fprintf(fp, "%s DO I = 1, LEN(OutData%%%s)\n", indent, r->name); + fprintf(fp, "%s OutData%%%s%s(I:I) = CHAR(IntKiBuf(Int_Xferred))\n", indent, r->name, dimstr(r->ndims)); + fprintf(fp, "%s Int_Xferred = Int_Xferred + 1\n", indent); + fprintf(fp, "%s END DO ! I\n", indent); - for (d = r->ndims; d >= 1; d--) { - fprintf(fp, " END DO !i%d\n", d); - } } - fprintf(fp, " DEALLOCATE(mask%d)\n", r->ndims); - - } - else { - // scalar intrinsic data types - // do all dimensions of arrays (no need for loop over i%d) - if (!strcmp(r->type->mapsto, "REAL(ReKi)")) { - fprintf(fp, " OutData%%%s = ReKiBuf( Re_Xferred )\n", r->name); - fprintf(fp, " Re_Xferred = Re_Xferred + 1\n"); - } - else if (!strcmp(r->type->mapsto, "REAL(SiKi)")) - { - fprintf(fp, " OutData%%%s = REAL( ReKiBuf( Re_Xferred ), SiKi) \n", r->name); - fprintf(fp, " Re_Xferred = Re_Xferred + 1\n"); - } - else if (!strcmp(r->type->mapsto, "REAL(DbKi)")) { - fprintf(fp, " OutData%%%s = DbKiBuf( Db_Xferred ) \n", r->name); - fprintf(fp, " Db_Xferred = Db_Xferred + 1\n"); - } - else if (!strcmp(r->type->mapsto, "REAL(R8Ki)")) { - fprintf(fp, " OutData%%%s = REAL( DbKiBuf( Db_Xferred ), R8Ki) \n", r->name); - fprintf(fp, " Db_Xferred = Db_Xferred + 1\n"); - } - else if (!strcmp(r->type->mapsto, "INTEGER(IntKi)")) { - fprintf(fp, " OutData%%%s = IntKiBuf( Int_Xferred ) \n", r->name); - fprintf(fp, " Int_Xferred = Int_Xferred + 1\n"); - } - else if (!strcmp(r->type->mapsto, "LOGICAL")) { - fprintf(fp, " OutData%%%s = TRANSFER( IntKiBuf( Int_Xferred ), mask0 )\n", r->name); - fprintf(fp, " Int_Xferred = Int_Xferred + 1\n"); - } - - else /*if (!strcmp(r->type->mapsto, "CHARACTER")) */{ - - fprintf(fp, " DO I = 1, LEN(OutData%%%s)\n", r->name); - fprintf(fp, " OutData%%%s(I:I) = CHAR(IntKiBuf(Int_Xferred))\n", r->name); - fprintf(fp, " Int_Xferred = Int_Xferred + 1\n"); - fprintf(fp, " END DO ! I\n"); + for (d = r->ndims; d >= 1; d--) { + strcpy(indent, " "); + strcat(indent, mainIndent); + for (i = 1; i < d; i++) { + strcat(indent, " "); + } + fprintf(fp, "%s END DO\n", indent); } -// need to move this (scalars and strings) to the %c_obj% type, too! +// need to move scalars and strings to the %c_obj% type, too! // compare with copy routine - if (sw_ccode && !has_deferred_dim(r, 0)) { + + if (sw_ccode && !is_pointer(r) && r->ndims == 0) { if (!strcmp(r->type->mapsto, "REAL(ReKi)") || !strcmp(r->type->mapsto, "REAL(SiKi)") || !strcmp(r->type->mapsto, "REAL(DbKi)") || @@ -877,9 +903,7 @@ gen_unpack( FILE * fp, const node_t * ModName, char * inout, char * inoutlong ) fprintf(fp, " OutData%%C_obj%%%s = OutData%%%s\n", r->name, r->name); } else { // characters need to be copied differently - if (r->ndims == 0){ - fprintf(fp, " OutData%%C_obj%%%s = TRANSFER(OutData%%%s, OutData%%C_obj%%%s )\n", r->name, r->name, r->name); - } + fprintf(fp, " OutData%%C_obj%%%s = TRANSFER(OutData%%%s, OutData%%C_obj%%%s )\n", r->name, r->name, r->name); } } @@ -1000,7 +1024,7 @@ void gen_extint_order(FILE *fp, const node_t *ModName, char * typnm, char * uy, node_t *q, *r1 ; int j ; int mesh = 0 ; - char derefrecurse[NAMELEN],dex[NAMELEN],tmp[NAMELEN] ; + char derefrecurse[NAMELEN],tmp[NAMELEN] ; if ( recurselevel > MAXRECURSE ) { fprintf(stderr,"REGISTRY ERROR: too many levels of array subtypes\n") ; exit(9) ; @@ -1028,24 +1052,19 @@ void gen_extint_order(FILE *fp, const node_t *ModName, char * typnm, char * uy, } } } else if ( !strcmp( r->type->mapsto, "MeshType" ) ) { - strcpy(dex,"") ; for ( j = r->ndims ; j > 0 ; j-- ) { - fprintf(fp, " DO i%d%d = LBOUND(%s_out%s%%%s,%d),UBOUND(%s_out%s%%%s,%d)\n", 0, 1, uy, deref, r->name, j, uy, deref, r->name, j); - if ( j == r->ndims ) strcat(dex,"(") ; - sprintf(tmp,"i%d%d",0,j) ; - if ( j == 1 ) strcat(tmp,")") ; else strcat(tmp,",") ; - strcat(dex,tmp) ; + fprintf(fp, " DO i%d%d = LBOUND(%s_out%s%%%s,%d),UBOUND(%s_out%s%%%s,%d)\n", 0, j, uy, deref, r->name, j, uy, deref, r->name, j); } if ( order == 0 ) { - fprintf(fp, " CALL MeshCopy(%s(1)%s%%%s%s, %s_out%s%%%s%s, MESH_UPDATECOPY, ErrStat2, ErrMsg2 )\n", uy, deref, r->name, dex - , uy, deref, r->name, dex); + fprintf(fp, " CALL MeshCopy(%s(1)%s%%%s%s, %s_out%s%%%s%s, MESH_UPDATECOPY, ErrStat2, ErrMsg2 )\n", uy, deref, r->name, dimstr(r->ndims) + , uy, deref, r->name, dimstr(r->ndims)); } else if ( order == 1 ) { fprintf(fp," CALL MeshExtrapInterp1(%s(1)%s%%%s%s, %s(2)%s%%%s%s, tin, %s_out%s%%%s%s, tin_out, ErrStat2, ErrMsg2 )\n" - , uy, deref, r->name, dex, uy, deref, r->name, dex, uy, deref, r->name, dex); + , uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); } else if ( order == 2 ) { fprintf(fp," CALL MeshExtrapInterp2(%s(1)%s%%%s%s, %s(2)%s%%%s%s, %s(3)%s%%%s%s, tin, %s_out%s%%%s%s, tin_out, ErrStat2, ErrMsg2 )\n" - , uy, deref, r->name, dex, uy, deref, r->name, dex, uy, deref, r->name, dex, uy, deref, r->name, dex); + , uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); } fprintf(fp, " CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName)\n"); fprintf(fp, " IF (ErrStat>=AbortErrLev) RETURN\n"); @@ -1058,19 +1077,19 @@ void gen_extint_order(FILE *fp, const node_t *ModName, char * typnm, char * uy, char nonick2[NAMELEN] ; remove_nickname(r->type->module->nickname,r->type->name,nonick2) ; - strcpy(dex,"") ; + strcpy(dimstr(r->ndims),"") ; for ( j = r->ndims ; j >= 1 ; j-- ) { - fprintf(fp, " DO i%d%d = LBOUND(%s_out%s%%%s,%d), UBOUND(%s_out%s%%%s,%d)\n", 0, 1, uy, deref, r->name, j, uy, deref, r->name, j); - if ( j == r->ndims ) strcat(dex,"(") ; + fprintf(fp, " DO i%d%d = LBOUND(%s_out%s%%%s,%d), UBOUND(%s_out%s%%%s,%d)\n", 0, j, uy, deref, r->name, j, uy, deref, r->name, j); + if ( j == r->ndims ) strcat(dimstr(r->ndims),"(") ; sprintf(tmp,"i%d%d",0,j) ; if ( j == 1 ) strcat(tmp,")") ; else strcat(tmp,",") ; - strcat(dex,tmp) ; + strcat(dimstr(r->ndims),tmp) ; } fprintf(fp," CALL %s_%s_ExtrapInterp( %s%s%%%s%s, tin, %s_out%s%%%s%s, tin_out, ErrStat2, ErrMsg2 )\n", r->type->module->nickname,fast_interface_type_shortname(nonick2) - , uy, deref, r->name, dex, uy, deref, r->name, dex); + , uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); fprintf(fp," CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName)\n"); fprintf(fp," IF (ErrStat>=AbortErrLev) RETURN\n"); @@ -1139,9 +1158,9 @@ void gen_extint_order(FILE *fp, const node_t *ModName, char * typnm, char * uy, #endif void gen_extint_order(FILE *fp, const node_t *ModName, char * typnm, char * uy, const int order, node_t *r, char * deref, int recurselevel) { node_t *q, *r1; - int j; + int i, j; int mesh = 0; - char derefrecurse[NAMELEN], dex[NAMELEN], tmp[NAMELEN]; + char derefrecurse[NAMELEN], indent[NAMELEN], tmp[NAMELEN]; if (recurselevel > MAXRECURSE) { fprintf(stderr, "REGISTRY ERROR: too many levels of array subtypes\n"); exit(9); @@ -1155,17 +1174,28 @@ void gen_extint_order(FILE *fp, const node_t *ModName, char * typnm, char * uy, } if (r->type->type_type == DERIVED) { - - if ((q = get_entry(make_lower_temp(r->type->name), ModName->module_ddt_list)) != NULL) { for (r1 = q->fields; r1; r1 = r1->next) { sprintf(derefrecurse, "%s%%%s", deref, r->name); - for (j = r->ndims; j > 0; j--) { + for (j = r->ndims; j > 0; j--) { fprintf(fp, " DO i%d%d = LBOUND(%s_out%s,%d),UBOUND(%s_out%s,%d)\n", recurselevel, j, uy, derefrecurse, j, uy, derefrecurse, j); - sprintf(derefrecurse, "%s%%%s(i%d%d)", deref, r->name, recurselevel, j); } + + + if (r->ndims > 0) { + strcat(derefrecurse, "("); + for (j = 1; j <= r->ndims; j++) { + sprintf(tmp, "i%d%d", recurselevel, j); + strcat(derefrecurse, tmp); + if (j < r->ndims) { + strcat(derefrecurse, ","); + } + } + strcat(derefrecurse, ")"); + } + gen_extint_order(fp, ModName, typnm, uy, order, r1, derefrecurse, recurselevel + 1); for (j = r->ndims; j > 0; j--) { fprintf(fp, " ENDDO\n"); @@ -1175,27 +1205,22 @@ void gen_extint_order(FILE *fp, const node_t *ModName, char * typnm, char * uy, else { - strcpy(dex, ""); for (j = r->ndims; j > 0; j--) { - fprintf(fp, " DO i%d%d = LBOUND(%s_out%s%%%s,%d),UBOUND(%s_out%s%%%s,%d)\n", 0, 1, uy, deref, r->name, j, uy, deref, r->name, j); - if (j == r->ndims) strcat(dex, "("); - sprintf(tmp, "i%d%d", 0, j); - if (j == 1) strcat(tmp, ")"); else strcat(tmp, ","); - strcat(dex, tmp); + fprintf(fp, " DO i%d = LBOUND(%s_out%s%%%s,%d),UBOUND(%s_out%s%%%s,%d)\n", j, uy, deref, r->name, j, uy, deref, r->name, j); } if (!strcmp(r->type->mapsto, "MeshType")) { if (order == 0) { - fprintf(fp, " CALL MeshCopy(%s1%s%%%s%s, %s_out%s%%%s%s, MESH_UPDATECOPY, ErrStat2, ErrMsg2 )\n", uy, deref, r->name, dex - , uy, deref, r->name, dex); + fprintf(fp, " CALL MeshCopy(%s1%s%%%s%s, %s_out%s%%%s%s, MESH_UPDATECOPY, ErrStat2, ErrMsg2 )\n", uy, deref, r->name, dimstr(r->ndims) + , uy, deref, r->name, dimstr(r->ndims)); } else if (order == 1) { fprintf(fp, " CALL MeshExtrapInterp1(%s1%s%%%s%s, %s2%s%%%s%s, tin, %s_out%s%%%s%s, tin_out, ErrStat2, ErrMsg2 )\n" - , uy, deref, r->name, dex, uy, deref, r->name, dex, uy, deref, r->name, dex); + , uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); } else if (order == 2) { fprintf(fp, " CALL MeshExtrapInterp2(%s1%s%%%s%s, %s2%s%%%s%s, %s3%s%%%s%s, tin, %s_out%s%%%s%s, tin_out, ErrStat2, ErrMsg2 )\n" - , uy, deref, r->name, dex, uy, deref, r->name, dex, uy, deref, r->name, dex, uy, deref, r->name, dex); + , uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); } } else { @@ -1204,17 +1229,17 @@ void gen_extint_order(FILE *fp, const node_t *ModName, char * typnm, char * uy, if (order == 0) { fprintf(fp, " CALL %s_Copy%s(%s1%s%%%s%s, %s_out%s%%%s%s, MESH_UPDATECOPY, ErrStat2, ErrMsg2 )\n", r->type->module->nickname, fast_interface_type_shortname(nonick2) - , uy, deref, r->name, dex, uy, deref, r->name, dex); + , uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); } else if (order == 1) { fprintf(fp, " CALL %s_%s_ExtrapInterp1( %s1%s%%%s%s, %s2%s%%%s%s, tin, %s_out%s%%%s%s, tin_out, ErrStat2, ErrMsg2 )\n", r->type->module->nickname, fast_interface_type_shortname(nonick2) - , uy, deref, r->name, dex, uy, deref, r->name, dex, uy, deref, r->name, dex); + , uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); } else if (order == 2) { fprintf(fp, " CALL %s_%s_ExtrapInterp2( %s1%s%%%s%s, %s2%s%%%s%s, %s3%s%%%s%s, tin, %s_out%s%%%s%s, tin_out, ErrStat2, ErrMsg2 )\n", r->type->module->nickname, fast_interface_type_shortname(nonick2) - , uy, deref, r->name, dex, uy, deref, r->name, dex, uy, deref, r->name, dex, uy, deref, r->name, dex); + , uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); } } @@ -1230,67 +1255,59 @@ void gen_extint_order(FILE *fp, const node_t *ModName, char * typnm, char * uy, !strcmp(r->type->mapsto, "REAL(SiKi)") || !strcmp(r->type->mapsto, "REAL(R8Ki)") || !strcmp(r->type->mapsto, "REAL(DbKi)")) { - if (r->ndims == 0) { - } - else if (r->ndims == 1 && order > 0) { - fprintf(fp, " ALLOCATE(b1(SIZE(%s_out%s%%%s,1)))\n", uy, deref, r->name); - fprintf(fp, " ALLOCATE(c1(SIZE(%s_out%s%%%s,1)))\n", uy, deref, r->name); - } - else if (r->ndims == 2 && order > 0) { - fprintf(fp, " ALLOCATE(b2(SIZE(%s_out%s%%%s,1),SIZE(%s_out%s%%%s,2) ))\n", uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " ALLOCATE(c2(SIZE(%s_out%s%%%s,1),SIZE(%s_out%s%%%s,2) ))\n", uy, deref, r->name, uy, deref, r->name); - } - else if (r->ndims == 3 && order > 0) { - fprintf(fp, " ALLOCATE(b3(SIZE(%s_out%s%%%s,1),SIZE(%s_out%s%%%s,2), &\n", uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " SIZE(%s_out%s%%%s,3) ))\n", uy, deref, r->name); - fprintf(fp, " ALLOCATE(c3(SIZE(%s_out%s%%%s,1),SIZE(%s_out%s%%%s,2), &\n", uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " SIZE(%s_out%s%%%s,3) ))\n", uy, deref, r->name); - } - else if (r->ndims == 4 && order > 0) { - fprintf(fp, " ALLOCATE(b4(SIZE(%s_out%s%%%s,1),SIZE(%s_out%s%%%s,2), &\n", uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " SIZE(%s_out%s%%%s,3),SIZE(%s_out%s%%%s,4) ))\n", uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " ALLOCATE(c4(SIZE(%s_out%s%%%s,1),SIZE(%s_out%s%%%s,2), &\n", uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " SIZE(%s_out%s%%%s,3),SIZE(%s_out%s%%%s,4) ))\n", uy, deref, r->name, uy, deref, r->name); - } - else if (r->ndims == 5 && order > 0) { - fprintf(fp, " ALLOCATE(b5(SIZE(%s_out%s%%%s,1),SIZE(%s_out%s%%%s,2), &\n", uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " SIZE(%s_out%s%%%s,3),SIZE(%s_out%s%%%s,4), &\n", uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " SIZE(%s_out%s%%%s,5) ))\n", uy, deref, r->name); - fprintf(fp, " ALLOCATE(c5(SIZE(%s_out%s%%%s,1),SIZE(%s_out%s%%%s,2), &\n", uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " SIZE(%s_out%s%%%s,3),SIZE(%s_out%s%%%s,4), &\n", uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " SIZE(%s_out%s%%%s,5) ))\n", uy, deref, r->name); - } - else { - if (order > 0) fprintf(stderr, "Registry WARNING: too many dimensions for %s%%%s\n", deref, r->name); - } + if (order == 0) { + //bjj: this should probably have some "IF ALLOCATED" statements around it, but we're just calling + // the copy routine fprintf(fp, " %s_out%s%%%s = %s1%s%%%s\n", uy, deref, r->name, uy, deref, r->name); } - else if (order == 1) { - fprintf(fp, " b%d = -(%s1%s%%%s - %s2%s%%%s)/t(2)\n", r->ndims, uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " %s_out%s%%%s = %s1%s%%%s + b%d * t_out\n", uy, deref, r->name, uy, deref, r->name, r->ndims); - } - else if (order == 2) { - fprintf(fp, " b%d = (t(3)**2*(%s1%s%%%s - %s2%s%%%s) + t(2)**2*(-%s1%s%%%s + %s3%s%%%s))/(t(2)*t(3)*(t(2) - t(3)))\n", - r->ndims, uy, deref, r->name, uy, deref, r->name, uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " c%d = ( (t(2)-t(3))*%s1%s%%%s + t(3)*%s2%s%%%s - t(2)*%s3%s%%%s ) / (t(2)*t(3)*(t(2) - t(3)))\n", - r->ndims, uy, deref, r->name, uy, deref, r->name, uy, deref, r->name); - fprintf(fp, " %s_out%s%%%s = %s1%s%%%s + b%d * t_out + c%d * t_out**2\n" - , uy, deref, r->name, uy, deref, r->name, r->ndims, r->ndims); - } - if (r->ndims >= 1 && order > 0) { - fprintf(fp, " DEALLOCATE(b%d)\n", r->ndims); - fprintf(fp, " DEALLOCATE(c%d)\n", r->ndims); + else + strcpy(indent, ""); + for (j = r->ndims; j > 0; j--) { + fprintf(fp, "%s DO i%d = LBOUND(%s_out%s%%%s,%d),UBOUND(%s_out%s%%%s,%d)\n", indent, j, uy, deref, r->name, j, uy, deref, r->name, j); + strcat(indent, " "); //create an indent + } + + if (order == 1) { + if (r->gen_periodic) { + fprintf(fp, "%s CALL Angles_ExtrapInterp( %s1%s%%%s%s, %s2%s%%%s%s, tin, %s_out%s%%%s%s, tin_out )\n", + indent, uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); + } + else { + fprintf(fp, "%s b = -(%s1%s%%%s%s - %s2%s%%%s%s)\n", indent, uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); + fprintf(fp, "%s %s_out%s%%%s%s = %s1%s%%%s%s + b * ScaleFactor\n", indent, uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); + }; + } + if (order == 2) { + if (r->gen_periodic) { + fprintf(fp, "%s CALL Angles_ExtrapInterp( %s1%s%%%s%s, %s2%s%%%s%s, %s3%s%%%s%s, tin, %s_out%s%%%s%s, tin_out )\n", + indent, uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); + } + else { + fprintf(fp, "%s b = (t(3)**2*(%s1%s%%%s%s - %s2%s%%%s%s) + t(2)**2*(-%s1%s%%%s%s + %s3%s%%%s%s))* scaleFactor\n", + indent, uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); + fprintf(fp, "%s c = ( (t(2)-t(3))*%s1%s%%%s%s + t(3)*%s2%s%%%s%s - t(2)*%s3%s%%%s%s ) * scaleFactor\n", + indent, uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); + fprintf(fp, "%s %s_out%s%%%s%s = %s1%s%%%s%s + b + c * t_out\n", + indent, uy, deref, r->name, dimstr(r->ndims), uy, deref, r->name, dimstr(r->ndims)); + } + } + for (j = r->ndims; j >= 1; j--) { + strcpy(indent, ""); + for (i = 1; i < j; i++) { + strcat(indent, " "); + } + fprintf(fp, "%s END DO\n", indent); + } } - } // check if this is an allocatable array: if (r->ndims > 0 && has_deferred_dim(r, 0)) { fprintf(fp, "END IF ! check if allocated\n"); } - } -} + +} // gen_extint_order void calc_extint_order(FILE *fp, const node_t *ModName, node_t *r, int recurselevel, int *max_ndims, int *max_nrecurs, int *max_alloc_ndims) { node_t *q, *r1 ; @@ -1327,6 +1344,7 @@ void calc_extint_order(FILE *fp, const node_t *ModName, node_t *r, int recursele !strcmp(r->type->mapsto, "REAL(R8Ki)") || !strcmp(r->type->mapsto, "REAL(DbKi)")) { if (/*order > 0 &&*/ r->ndims > *max_alloc_ndims) *max_alloc_ndims = r->ndims; + if (r->ndims > *max_ndims)* max_ndims = r->ndims; } @@ -1574,30 +1592,8 @@ gen_ExtrapInterp1(FILE *fp, const node_t * ModName, char * typnm, char * typnmlo fprintf(fp, " CHARACTER(*), PARAMETER :: RoutineName = '%s_%s_ExtrapInterp1'\n", ModName->nickname, typnm); - if (max_alloc_ndims >= 0){ - fprintf(fp, " REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation\n"); - fprintf(fp, " REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation\n"); - if (max_alloc_ndims >= 1){ - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation\n"); - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation\n"); - if (max_alloc_ndims >= 2){ - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation\n"); - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation\n"); - if (max_alloc_ndims >= 3){ - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: b3 ! temporary for extrapolation/interpolation\n"); - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: c3 ! temporary for extrapolation/interpolation\n"); - if (max_alloc_ndims >= 4){ - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:,:) :: b4 ! temporary for extrapolation/interpolation\n"); - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:,:) :: c4 ! temporary for extrapolation/interpolation\n"); - if (max_alloc_ndims >= 5){ - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:,:,:):: b5 ! temporary for extrapolation/interpolation\n"); - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:,:,:):: c5 ! temporary for extrapolation/interpolation\n"); - } // 5 - } // 4 - } // 3 - } // 2 - } // 1 - } // 0 + fprintf(fp, " REAL(DbKi) :: b ! temporary for extrapolation/interpolation\n"); + fprintf(fp, " REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation\n"); fprintf(fp, " INTEGER(IntKi) :: ErrStat2 ! local errors\n"); fprintf(fp, " CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors\n"); for (j = 1; j <= max_ndims; j++) { @@ -1605,6 +1601,9 @@ gen_ExtrapInterp1(FILE *fp, const node_t * ModName, char * typnm, char * typnmlo fprintf(fp, " INTEGER :: i%d%d ! dim%d level %d counter variable for arrays of ddts\n", i, j, j, i); } } + for (j = 1; j <= max_ndims; j++) { + fprintf(fp, " INTEGER :: i%d ! dim%d counter variable for arrays\n", j, j); + } fprintf(fp, " ! Initialize ErrStat\n"); fprintf(fp, " ErrStat = ErrID_None\n"); @@ -1618,8 +1617,9 @@ gen_ExtrapInterp1(FILE *fp, const node_t * ModName, char * typnm, char * typnmlo fprintf(fp, " IF ( EqualRealNos( t(1), t(2) ) ) THEN\n"); fprintf(fp, " CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName)\n"); fprintf(fp, " RETURN\n"); - fprintf(fp, " END IF\n"); + fprintf(fp, " END IF\n\n"); + fprintf(fp, " ScaleFactor = t_out / t(2)\n"); for (r = q->fields; r; r = r->next) { @@ -1654,45 +1654,23 @@ gen_ExtrapInterp2(FILE *fp, const node_t * ModName, char * typnm, char * typnmlo fprintf(fp, "!..................................................................................................................................\n"); fprintf(fp, "\n"); - fprintf(fp, " TYPE(%s_%s), INTENT(%s) :: %s1 ! %s at t1 > t2 > t3\n", ModName->nickname, typnmlong, (q->containsPtr == 1) ? "INOUT" : "IN", uy, typnm); fprintf(fp, " TYPE(%s_%s), INTENT(%s) :: %s2 ! %s at t2 > t3\n", ModName->nickname, typnmlong, (q->containsPtr == 1) ? "INOUT" : "IN", uy, typnm); fprintf(fp, " TYPE(%s_%s), INTENT(%s) :: %s3 ! %s at t3\n", ModName->nickname, typnmlong, (q->containsPtr == 1) ? "INOUT" : "IN", uy, typnm); fprintf(fp, " REAL(%s), INTENT(IN ) :: tin(3) ! Times associated with the %ss\n", xtypnm, typnm); fprintf(fp, " TYPE(%s_%s), INTENT(INOUT) :: %s_out ! %s at tin_out\n", ModName->nickname, typnmlong, uy, typnm); fprintf(fp, " REAL(%s), INTENT(IN ) :: tin_out ! time to be extrap/interp'd to\n", xtypnm); - fprintf(fp, " INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation\n"); + + fprintf(fp, " INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation\n" ); fprintf(fp, " CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None\n"); fprintf(fp, " ! local variables\n"); fprintf(fp, " REAL(%s) :: t(3) ! Times associated with the %ss\n", xtypnm, typnm); fprintf(fp, " REAL(%s) :: t_out ! Time to which to be extrap/interpd\n", xtypnm); fprintf(fp, " INTEGER(IntKi) :: order ! order of polynomial fit (max 2)\n"); - - if (max_alloc_ndims >= 0){ - fprintf(fp, " REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation\n"); - fprintf(fp, " REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation\n"); - if (max_alloc_ndims >= 1){ - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation\n"); - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation\n"); - if (max_alloc_ndims >= 2){ - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: b2 ! temporary for extrapolation/interpolation\n"); - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:,:) :: c2 ! temporary for extrapolation/interpolation\n"); - if (max_alloc_ndims >= 3){ - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: b3 ! temporary for extrapolation/interpolation\n"); - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:) :: c3 ! temporary for extrapolation/interpolation\n"); - if (max_alloc_ndims >= 4){ - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:,:) :: b4 ! temporary for extrapolation/interpolation\n"); - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:,:) :: c4 ! temporary for extrapolation/interpolation\n"); - if (max_alloc_ndims >= 5){ - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:,:,:):: b5 ! temporary for extrapolation/interpolation\n"); - fprintf(fp, " REAL(DbKi),ALLOCATABLE,DIMENSION(:,:,:,:,:):: c5 ! temporary for extrapolation/interpolation\n"); - } // 5 - } // 4 - } // 3 - } // 2 - } // 1 - } // 0 + fprintf(fp, " REAL(DbKi) :: b ! temporary for extrapolation/interpolation\n"); + fprintf(fp, " REAL(DbKi) :: c ! temporary for extrapolation/interpolation\n"); + fprintf(fp, " REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation\n"); fprintf(fp, " INTEGER(IntKi) :: ErrStat2 ! local errors\n"); fprintf(fp, " CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors\n"); fprintf(fp, " CHARACTER(*), PARAMETER :: RoutineName = '%s_%s_ExtrapInterp2'\n", ModName->nickname, typnm); @@ -1701,6 +1679,9 @@ gen_ExtrapInterp2(FILE *fp, const node_t * ModName, char * typnm, char * typnmlo fprintf(fp, " INTEGER :: i%d%d ! dim%d level %d counter variable for arrays of ddts\n", i, j, j, i); } } + for (j = 1; j <= max_ndims; j++) { + fprintf(fp, " INTEGER :: i%d ! dim%d counter variable for arrays\n", j, j); + } fprintf(fp, " ! Initialize ErrStat\n"); fprintf(fp, " ErrStat = ErrID_None\n"); fprintf(fp, " ErrMsg = \"\"\n"); @@ -1720,7 +1701,11 @@ gen_ExtrapInterp2(FILE *fp, const node_t * ModName, char * typnm, char * typnmlo fprintf(fp, " ELSE IF ( EqualRealNos( t(1), t(3) ) ) THEN\n"); fprintf(fp, " CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName)\n"); fprintf(fp, " RETURN\n"); - fprintf(fp, " END IF\n"); + fprintf(fp, " END IF\n\n"); + + fprintf(fp, " ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3)))\n"); + + for (r = q->fields; r; r = r->next) { @@ -2256,6 +2241,7 @@ gen_module( FILE * fp , node_t * ModName, char * prog_ver ) gen_unpack( fp, ModName, ddtname, ddtnamelong ) ; if ( sw_ccode ) { gen_copy_c2f( fp, ModName, ddtname, ddtnamelong ) ; + gen_copy_f2c(fp, ModName, ddtname, ddtnamelong); } } @@ -2390,6 +2376,15 @@ char * dimstr( int d ) retval = " REGISTRY ERROR TOO MANY DIMS " ; } return(retval) ; + + //strcpy(dex, ""); + //strcat(dex, "("); + //for (j = 1; j <= d; j++) { + // sprintf(tmp, "i%d%d", 0, j); + // strcat(dex, tmp); + // if (j == d) strcat(dex, ")"); else strcat(dex, ","); + //} + } char * dimstr_c( int d ) diff --git a/modules/openfast-registry/src/reg_parse.c b/modules/openfast-registry/src/reg_parse.c index 0ec9f3c7db..37d457abc2 100644 --- a/modules/openfast-registry/src/reg_parse.c +++ b/modules/openfast-registry/src/reg_parse.c @@ -95,7 +95,7 @@ pre_parse( char * dir, FILE * infile, FILE * outfile, int usefrom_sw ) // See if it might be in the current directory sprintf( include_file_name , "%s", p ) ; // first name in line from registry file, without the include or usefrom for ( p2 = include_file_name ; !( *p2 == ' ' || *p2 == '\t' || *p2 == '\n' ) && *p2 != '\0' ; p2++ ) {} - *p2 = '\0' ; // drop tailing white space + *p2 = '\0' ; // drop tailing white space if ( (q=index(include_file_name,'\n')) != NULL ) *q = '\0' ; if (( include_fp = fopen( include_file_name , "r" )) != NULL ) { foundit = 1 ; goto gotit ; } @@ -269,7 +269,7 @@ pre_parse( char * dir, FILE * infile, FILE * outfile, int usefrom_sw ) -normal: +//normal: /* otherwise output the line as is */ fprintf(outfile,"%s\n",parseline_save) ; parseline[0] = '\0' ; /* reset parseline */ @@ -284,8 +284,8 @@ reg_parse( FILE * infile ) /* Had to increase size for SOA from 4096 to 7000, Manish Shrivastava 2010 */ char inln[INLN_SIZE], parseline[PARSELINE_SIZE] ; char *p ; - char *tokens[MAXTOKENS], *ditto[MAXTOKENS] ; - int i ; + char *tokens[MAXTOKENS],*ditto[MAXTOKENS] ; + int i ; int defining_state_field, defining_rconfig_field, defining_i1_field ; parseline[0] = '\0' ; @@ -449,7 +449,6 @@ reg_parse( FILE * infile ) strcpy(field_struct->units,"-") ; if ( strcmp( tokens[FIELD_UNITS], "-" ) ) /* that is, if not equal "-" */ { strcpy( field_struct->units , tokens[FIELD_UNITS] ) ; } - #ifdef OVERSTRICT if ( field_struct->type != NULL ) if ( field_struct->type->type_type == DERIVED && field_struct->ndims > 0 ) @@ -615,27 +614,19 @@ set_dim_len ( char * dimspec , node_t * dim_entry ) int set_ctrl( char *ctrl , node_t * field_struct ) -// process CTRL keys -- only 'h' (hidden) and 'e' (exposed). Default is not to generate a wrapper, -// so something must be specified, either h or e +// process CTRL keys -- only '2pi' (interpolation of values with 2pi period). Default is no special interpolation. { - char prev = '\0' ; - char x ; char tmp[NAMELEN] ; char *p ; - int i ; strcpy(tmp,ctrl) ; if (( p = index(tmp,'=') ) != NULL ) { *p = '\0' ; } - for ( i = 0 ; i < strlen(tmp) ; i++ ) - { - x = tolower(tmp[i]) ; - if ( x == 'h' ) { - field_struct->gen_wrapper = WRAP_HIDDEN_FIELD ; - } else if ( x == 'e' ) { - field_struct->gen_wrapper = WRAP_EXPOSED_FIELD ; - } else { - field_struct->gen_wrapper = WRAP_NONE ; /* default */ - } + if (!strcmp(make_lower_temp(tmp), "2pi")) { + field_struct->gen_periodic = PERIOD_2PI; + } + else { + field_struct->gen_periodic = PERIOD_NONE; } + return(0) ; } diff --git a/modules/openfast-registry/src/registry.h b/modules/openfast-registry/src/registry.h index 0356025fb2..524bbe7e1a 100644 --- a/modules/openfast-registry/src/registry.h +++ b/modules/openfast-registry/src/registry.h @@ -23,9 +23,9 @@ enum type_type { SIMPLE , DERIVED } ; enum proc_orient { ALL_Z_ON_PROC , ALL_X_ON_PROC , ALL_Y_ON_PROC } ; /* wrapping options */ -#define WRAP_HIDDEN_FIELD 2 -#define WRAP_EXPOSED_FIELD 1 -#define WRAP_NONE 0 +#define PERIOD_2PI 2 +#define PERIOD_OTHER 1 +#define PERIOD_NONE 0 /* node_kind mask settings */ diff --git a/modules/openfoam/src/OpenFOAM.f90 b/modules/openfoam/src/OpenFOAM.f90 index 2e004a541f..807f2644ba 100644 --- a/modules/openfoam/src/OpenFOAM.f90 +++ b/modules/openfoam/src/OpenFOAM.f90 @@ -59,9 +59,7 @@ SUBROUTINE Init_OpFM( InitInp, p_FAST, AirDens, u_AD14, u_AD, initOut_AD, y_AD, CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None ! local variables - INTEGER(IntKi) :: NMappings ! number of blades INTEGER(IntKi) :: k ! blade loop counter - INTEGER(IntKi) :: j ! node counter INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None @@ -457,7 +455,6 @@ SUBROUTINE SetOpFMForces(p_FAST, p_AD14, u_AD14, y_AD14, u_AD, y_AD, y_ED, OpFM, ! Local variables: - REAL(ReKi ) :: factor ! scaling factor to get normalized forces for OpenFOAM REAL(ReKi) :: dRforceNodes ! Uniform distance between two consecutive blade force nodes REAL(ReKi) :: dHforceNodes ! Uniform distance between two consecutive tower force nodes @@ -1018,7 +1015,7 @@ SUBROUTINE CalcForceActuatorPositionsBlade(InitIn_OpFM, p_OpFM, structPositions, !Local variables INTEGER(IntKi) :: nStructNodes ! Number of velocity nodes REAL(ReKi), DIMENSION(:), ALLOCATABLE :: rStructNodes ! Distance of velocity nodes from the first node - Used as a parameter for curve fitting - INTEGER(IntKI) :: i,j,k ! Loop variables + INTEGER(IntKI) :: i ! Loop variables INTEGER(IntKI) :: jLower ! Index of the struct node just smaller than the force node REAL(ReKi) :: rInterp ! The location of this force node in (0,1) co-ordinates between the jLower and jLower+1 nodes @@ -1049,25 +1046,33 @@ SUBROUTINE CalcForceActuatorPositionsBlade(InitIn_OpFM, p_OpFM, structPositions, END SUBROUTINE CalcForceActuatorPositionsBlade !---------------------------------------------------------------------------------------------------------------------------------- -SUBROUTINE CalcForceActuatorPositionsTower(InitIn_OpFM, p_OpFM, structPositions, forceNodePositions, ErrStat2, ErrMsg2) +SUBROUTINE CalcForceActuatorPositionsTower(InitIn_OpFM, p_OpFM, structPositions, forceNodePositions, ErrStat, ErrMsg) TYPE(OpFM_InitInputType), INTENT(IN ) :: InitIn_OpFM ! data for the OpenFOAM integration module TYPE(OpFM_ParameterType), INTENT(IN ) :: p_OpFM ! data for the OpenFOAM integration module REAL(ReKi), POINTER :: structPositions(:,:) ! structural model positions REAL(ReKi), INTENT(INOUT) :: forceNodePositions(:,:) ! Array to store the newly created positions - INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation - CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None + INTEGER(IntKi) , intent(out) :: ErrStat ! temporary Error status of the operation + CHARACTER(ErrMsgLen) , intent(out) :: ErrMsg ! temporary Error message if ErrStat /= ErrID_None !Local variables INTEGER(IntKi) :: nStructNodes ! Number of velocity nodes REAL(ReKi), DIMENSION(:), ALLOCATABLE :: hStructNodes ! Distance of velocity nodes from the first node - Used as a parameter for curve fitting - INTEGER(IntKI) :: i,j,k ! Loop variables + INTEGER(IntKI) :: i ! Loop variables INTEGER(IntKI) :: jLower ! Index of the struct node just smaller than the force node REAL(ReKi) :: hInterp ! The location of this force node in (0,1) co-ordinates between the jLower and jLower+1 nodes nStructNodes = SIZE(structPositions,2) - ALLOCATE(hStructNodes(nStructNodes), STAT=ErrStat2) + ALLOCATE(hStructNodes(nStructNodes), STAT=ErrStat) + IF (ErrStat /= 0) then + ErrStat=ErrID_Fatal + ErrMsg = "error allocating hStructNodes" + return + ELSE + ErrStat = ErrID_None + ErrMsg = "" + END IF ! Store the distance of the structural model nodes from the root into an array hStructNodes(1) = 0.0 ! First node @@ -1103,9 +1108,10 @@ SUBROUTINE OpFM_CreateActForceBladeTowerNodes(p_OpFM, ErrStat, ErrMsg) REAL(ReKi) :: dRforceNodes ! Uniform distance between two consecutive force nodes INTEGER(IntKI) :: i ! Loop variables INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation - CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None - + ErrStat = ErrID_None + ErrMsg = "" + ! Line2 to Line2 mapping expects the destination mesh to be smaller than the source mesh for deformation mapping and larger than the source mesh for load mapping. This forces me to create nodes at the very ends of the blade. !Do the blade first @@ -1142,14 +1148,15 @@ SUBROUTINE OpFM_InterpolateForceNodesChord(InitOut_AD, p_OpFM, u_OpFM, ErrStat, CHARACTER(ErrMsgLen) :: ErrMsg ! temporary Error message if ErrStat /= ErrID_None !Local variables - INTEGER(IntKI) :: i,j,k,node ! Loop variables + INTEGER(IntKI) :: i,k,node ! Loop variables INTEGER(IntKI) :: nNodesBladeProps ! Number of nodes in the blade properties for a given blade INTEGER(IntKI) :: nNodesTowerProps ! Number of nodes in the tower properties INTEGER(IntKI) :: jLower ! Index of the blade properties node just smaller than the force node - INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation - CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None REAL(ReKi) :: rInterp ! The location of this force node in (0,1) co-ordinates between the jLower and jLower+1 nodes + ErrStat = ErrID_None + ErrMsg = "" + ! Set the chord for the hub node to be zero. Ideally, I'd like this to be the hub radius. Will figure this out later. Node = 1 u_OpFM%forceNodesChord(Node) = 0.0_ReKi diff --git a/modules/openfoam/src/OpenFOAM_Types.f90 b/modules/openfoam/src/OpenFOAM_Types.f90 index 9d7db19f68..d613cd232a 100644 --- a/modules/openfoam/src/OpenFOAM_Types.f90 +++ b/modules/openfoam/src/OpenFOAM_Types.f90 @@ -378,14 +378,14 @@ SUBROUTINE OpFM_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumSC2Ctrl - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumCtrl2SC - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumActForcePtsBlade - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumActForcePtsTower - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumSC2Ctrl + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumCtrl2SC + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumActForcePtsBlade + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumActForcePtsTower + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ASSOCIATED(InData%StructBldRNodes) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -396,8 +396,10 @@ SUBROUTINE OpFM_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StructBldRNodes,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%StructBldRNodes)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%StructBldRNodes))-1 ) = PACK(InData%StructBldRNodes,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%StructBldRNodes) + DO i1 = LBOUND(InData%StructBldRNodes,1), UBOUND(InData%StructBldRNodes,1) + ReKiBuf(Re_Xferred) = InData%StructBldRNodes(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%StructTwrHNodes) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -409,15 +411,17 @@ SUBROUTINE OpFM_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%StructTwrHNodes,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%StructTwrHNodes)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%StructTwrHNodes))-1 ) = PACK(InData%StructTwrHNodes,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%StructTwrHNodes) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%BladeLength - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TowerHeight - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TowerBaseHeight - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%StructTwrHNodes,1), UBOUND(InData%StructTwrHNodes,1) + ReKiBuf(Re_Xferred) = InData%StructTwrHNodes(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%BladeLength + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TowerHeight + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TowerBaseHeight + Re_Xferred = Re_Xferred + 1 END SUBROUTINE OpFM_PackInitInput SUBROUTINE OpFM_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -433,12 +437,6 @@ SUBROUTINE OpFM_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -453,17 +451,17 @@ SUBROUTINE OpFM_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%NumSC2Ctrl = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NumSC2Ctrl = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 OutData%C_obj%NumSC2Ctrl = OutData%NumSC2Ctrl - OutData%NumCtrl2SC = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NumCtrl2SC = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 OutData%C_obj%NumCtrl2SC = OutData%NumCtrl2SC - OutData%NumActForcePtsBlade = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NumActForcePtsBlade = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 OutData%C_obj%NumActForcePtsBlade = OutData%NumActForcePtsBlade - OutData%NumActForcePtsTower = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NumActForcePtsTower = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 OutData%C_obj%NumActForcePtsTower = OutData%NumActForcePtsTower IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StructBldRNodes not allocated Int_Xferred = Int_Xferred + 1 @@ -481,15 +479,10 @@ SUBROUTINE OpFM_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E OutData%c_obj%StructBldRNodes_Len = SIZE(OutData%StructBldRNodes) IF (OutData%c_obj%StructBldRNodes_Len > 0) & OutData%c_obj%StructBldRNodes = C_LOC( OutData%StructBldRNodes(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%StructBldRNodes)>0) OutData%StructBldRNodes = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%StructBldRNodes))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%StructBldRNodes) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%StructBldRNodes,1), UBOUND(OutData%StructBldRNodes,1) + OutData%StructBldRNodes(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! StructTwrHNodes not allocated Int_Xferred = Int_Xferred + 1 @@ -507,57 +500,112 @@ SUBROUTINE OpFM_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E OutData%c_obj%StructTwrHNodes_Len = SIZE(OutData%StructTwrHNodes) IF (OutData%c_obj%StructTwrHNodes_Len > 0) & OutData%c_obj%StructTwrHNodes = C_LOC( OutData%StructTwrHNodes(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%StructTwrHNodes)>0) OutData%StructTwrHNodes = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%StructTwrHNodes))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%StructTwrHNodes) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%StructTwrHNodes,1), UBOUND(OutData%StructTwrHNodes,1) + OutData%StructTwrHNodes(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%BladeLength = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%BladeLength = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 OutData%C_obj%BladeLength = OutData%BladeLength - OutData%TowerHeight = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%TowerHeight = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 OutData%C_obj%TowerHeight = OutData%TowerHeight - OutData%TowerBaseHeight = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%TowerBaseHeight = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 OutData%C_obj%TowerBaseHeight = OutData%TowerBaseHeight END SUBROUTINE OpFM_UnPackInitInput - SUBROUTINE OpFM_C2Fary_CopyInitInput( InitInputData, ErrStat, ErrMsg ) + SUBROUTINE OpFM_C2Fary_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers ) TYPE(OpFM_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF InitInputData%NumSC2Ctrl = InitInputData%C_obj%NumSC2Ctrl InitInputData%NumCtrl2SC = InitInputData%C_obj%NumCtrl2SC InitInputData%NumActForcePtsBlade = InitInputData%C_obj%NumActForcePtsBlade InitInputData%NumActForcePtsTower = InitInputData%C_obj%NumActForcePtsTower ! -- StructBldRNodes InitInput Data fields - IF ( .NOT. C_ASSOCIATED( InitInputData%C_obj%StructBldRNodes ) ) THEN - NULLIFY( InitInputData%StructBldRNodes ) - ELSE - CALL C_F_POINTER(InitInputData%C_obj%StructBldRNodes, InitInputData%StructBldRNodes, (/InitInputData%C_obj%StructBldRNodes_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InitInputData%C_obj%StructBldRNodes ) ) THEN + NULLIFY( InitInputData%StructBldRNodes ) + ELSE + CALL C_F_POINTER(InitInputData%C_obj%StructBldRNodes, InitInputData%StructBldRNodes, (/InitInputData%C_obj%StructBldRNodes_Len/)) + END IF END IF ! -- StructTwrHNodes InitInput Data fields - IF ( .NOT. C_ASSOCIATED( InitInputData%C_obj%StructTwrHNodes ) ) THEN - NULLIFY( InitInputData%StructTwrHNodes ) - ELSE - CALL C_F_POINTER(InitInputData%C_obj%StructTwrHNodes, InitInputData%StructTwrHNodes, (/InitInputData%C_obj%StructTwrHNodes_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InitInputData%C_obj%StructTwrHNodes ) ) THEN + NULLIFY( InitInputData%StructTwrHNodes ) + ELSE + CALL C_F_POINTER(InitInputData%C_obj%StructTwrHNodes, InitInputData%StructTwrHNodes, (/InitInputData%C_obj%StructTwrHNodes_Len/)) + END IF END IF InitInputData%BladeLength = InitInputData%C_obj%BladeLength InitInputData%TowerHeight = InitInputData%C_obj%TowerHeight InitInputData%TowerBaseHeight = InitInputData%C_obj%TowerBaseHeight END SUBROUTINE OpFM_C2Fary_CopyInitInput + SUBROUTINE OpFM_F2C_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(OpFM_InitInputType), INTENT(INOUT) :: InitInputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + InitInputData%C_obj%NumSC2Ctrl = InitInputData%NumSC2Ctrl + InitInputData%C_obj%NumCtrl2SC = InitInputData%NumCtrl2SC + InitInputData%C_obj%NumActForcePtsBlade = InitInputData%NumActForcePtsBlade + InitInputData%C_obj%NumActForcePtsTower = InitInputData%NumActForcePtsTower + + ! -- StructBldRNodes InitInput Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InitInputData%StructBldRNodes)) THEN + InitInputData%c_obj%StructBldRNodes_Len = 0 + InitInputData%c_obj%StructBldRNodes = C_NULL_PTR + ELSE + InitInputData%c_obj%StructBldRNodes_Len = SIZE(InitInputData%StructBldRNodes) + IF (InitInputData%c_obj%StructBldRNodes_Len > 0) & + InitInputData%c_obj%StructBldRNodes = C_LOC( InitInputData%StructBldRNodes( LBOUND(InitInputData%StructBldRNodes,1) ) ) + END IF + END IF + + ! -- StructTwrHNodes InitInput Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InitInputData%StructTwrHNodes)) THEN + InitInputData%c_obj%StructTwrHNodes_Len = 0 + InitInputData%c_obj%StructTwrHNodes = C_NULL_PTR + ELSE + InitInputData%c_obj%StructTwrHNodes_Len = SIZE(InitInputData%StructTwrHNodes) + IF (InitInputData%c_obj%StructTwrHNodes_Len > 0) & + InitInputData%c_obj%StructTwrHNodes = C_LOC( InitInputData%StructTwrHNodes( LBOUND(InitInputData%StructTwrHNodes,1) ) ) + END IF + END IF + InitInputData%C_obj%BladeLength = InitInputData%BladeLength + InitInputData%C_obj%TowerHeight = InitInputData%TowerHeight + InitInputData%C_obj%TowerBaseHeight = InitInputData%TowerBaseHeight + END SUBROUTINE OpFM_F2C_CopyInitInput + SUBROUTINE OpFM_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(OpFM_InitOutputType), INTENT(IN) :: SrcInitOutputData TYPE(OpFM_InitOutputType), INTENT(INOUT) :: DstInitOutputData @@ -722,12 +770,12 @@ SUBROUTINE OpFM_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -739,12 +787,12 @@ SUBROUTINE OpFM_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + 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) @@ -789,12 +837,6 @@ SUBROUTINE OpFM_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -822,19 +864,12 @@ SUBROUTINE OpFM_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated Int_Xferred = Int_Xferred + 1 @@ -849,19 +884,12 @@ SUBROUTINE OpFM_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -905,15 +933,40 @@ SUBROUTINE OpFM_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END SUBROUTINE OpFM_UnPackInitOutput - SUBROUTINE OpFM_C2Fary_CopyInitOutput( InitOutputData, ErrStat, ErrMsg ) + SUBROUTINE OpFM_C2Fary_CopyInitOutput( InitOutputData, ErrStat, ErrMsg, SkipPointers ) TYPE(OpFM_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF END SUBROUTINE OpFM_C2Fary_CopyInitOutput + SUBROUTINE OpFM_F2C_CopyInitOutput( InitOutputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(OpFM_InitOutputType), INTENT(INOUT) :: InitOutputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + END SUBROUTINE OpFM_F2C_CopyInitOutput + SUBROUTINE OpFM_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) TYPE(OpFM_MiscVarType), INTENT(INOUT) :: SrcMiscData TYPE(OpFM_MiscVarType), INTENT(INOUT) :: DstMiscData @@ -1710,12 +1763,6 @@ SUBROUTINE OpFM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -2180,15 +2227,40 @@ SUBROUTINE OpFM_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg END IF END SUBROUTINE OpFM_UnPackMisc - SUBROUTINE OpFM_C2Fary_CopyMisc( MiscData, ErrStat, ErrMsg ) + SUBROUTINE OpFM_C2Fary_CopyMisc( MiscData, ErrStat, ErrMsg, SkipPointers ) TYPE(OpFM_MiscVarType), INTENT(INOUT) :: MiscData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF END SUBROUTINE OpFM_C2Fary_CopyMisc + SUBROUTINE OpFM_F2C_CopyMisc( MiscData, ErrStat, ErrMsg, SkipPointers ) + TYPE(OpFM_MiscVarType), INTENT(INOUT) :: MiscData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + END SUBROUTINE OpFM_F2C_CopyMisc + SUBROUTINE OpFM_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) TYPE(OpFM_ParameterType), INTENT(IN) :: SrcParamData TYPE(OpFM_ParameterType), INTENT(INOUT) :: DstParamData @@ -2363,20 +2435,20 @@ SUBROUTINE OpFM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AirDens - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumBl - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NMappings - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NnodesVel - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NnodesForce - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NnodesForceBlade - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NnodesForceTower - Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AirDens + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumBl + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NMappings + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NnodesVel + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NnodesForce + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NnodesForceBlade + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NnodesForceTower + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ASSOCIATED(InData%forceBldRnodes) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2387,8 +2459,10 @@ SUBROUTINE OpFM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%forceBldRnodes,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%forceBldRnodes)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%forceBldRnodes))-1 ) = PACK(InData%forceBldRnodes,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%forceBldRnodes) + DO i1 = LBOUND(InData%forceBldRnodes,1), UBOUND(InData%forceBldRnodes,1) + ReKiBuf(Re_Xferred) = InData%forceBldRnodes(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%forceTwrHnodes) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -2400,15 +2474,17 @@ SUBROUTINE OpFM_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%forceTwrHnodes,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%forceTwrHnodes)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%forceTwrHnodes))-1 ) = PACK(InData%forceTwrHnodes,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%forceTwrHnodes) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%BladeLength - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TowerHeight - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TowerBaseHeight - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%forceTwrHnodes,1), UBOUND(InData%forceTwrHnodes,1) + ReKiBuf(Re_Xferred) = InData%forceTwrHnodes(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%BladeLength + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TowerHeight + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TowerBaseHeight + Re_Xferred = Re_Xferred + 1 END SUBROUTINE OpFM_PackParam SUBROUTINE OpFM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2424,12 +2500,6 @@ SUBROUTINE OpFM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -2444,26 +2514,26 @@ SUBROUTINE OpFM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%AirDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%AirDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 OutData%C_obj%AirDens = OutData%AirDens - OutData%NumBl = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NumBl = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 OutData%C_obj%NumBl = OutData%NumBl - OutData%NMappings = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NMappings = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 OutData%C_obj%NMappings = OutData%NMappings - OutData%NnodesVel = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NnodesVel = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 OutData%C_obj%NnodesVel = OutData%NnodesVel - OutData%NnodesForce = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NnodesForce = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 OutData%C_obj%NnodesForce = OutData%NnodesForce - OutData%NnodesForceBlade = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NnodesForceBlade = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 OutData%C_obj%NnodesForceBlade = OutData%NnodesForceBlade - OutData%NnodesForceTower = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NnodesForceTower = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 OutData%C_obj%NnodesForceTower = OutData%NnodesForceTower IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! forceBldRnodes not allocated Int_Xferred = Int_Xferred + 1 @@ -2481,15 +2551,10 @@ SUBROUTINE OpFM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs OutData%c_obj%forceBldRnodes_Len = SIZE(OutData%forceBldRnodes) IF (OutData%c_obj%forceBldRnodes_Len > 0) & OutData%c_obj%forceBldRnodes = C_LOC( OutData%forceBldRnodes(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%forceBldRnodes)>0) OutData%forceBldRnodes = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%forceBldRnodes))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%forceBldRnodes) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%forceBldRnodes,1), UBOUND(OutData%forceBldRnodes,1) + OutData%forceBldRnodes(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! forceTwrHnodes not allocated Int_Xferred = Int_Xferred + 1 @@ -2507,34 +2572,37 @@ SUBROUTINE OpFM_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs OutData%c_obj%forceTwrHnodes_Len = SIZE(OutData%forceTwrHnodes) IF (OutData%c_obj%forceTwrHnodes_Len > 0) & OutData%c_obj%forceTwrHnodes = C_LOC( OutData%forceTwrHnodes(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%forceTwrHnodes)>0) OutData%forceTwrHnodes = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%forceTwrHnodes))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%forceTwrHnodes) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%forceTwrHnodes,1), UBOUND(OutData%forceTwrHnodes,1) + OutData%forceTwrHnodes(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%BladeLength = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%BladeLength = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 OutData%C_obj%BladeLength = OutData%BladeLength - OutData%TowerHeight = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%TowerHeight = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 OutData%C_obj%TowerHeight = OutData%TowerHeight - OutData%TowerBaseHeight = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%TowerBaseHeight = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 OutData%C_obj%TowerBaseHeight = OutData%TowerBaseHeight END SUBROUTINE OpFM_UnPackParam - SUBROUTINE OpFM_C2Fary_CopyParam( ParamData, ErrStat, ErrMsg ) + SUBROUTINE OpFM_C2Fary_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) TYPE(OpFM_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF ParamData%AirDens = ParamData%C_obj%AirDens ParamData%NumBl = ParamData%C_obj%NumBl ParamData%NMappings = ParamData%C_obj%NMappings @@ -2544,23 +2612,78 @@ SUBROUTINE OpFM_C2Fary_CopyParam( ParamData, ErrStat, ErrMsg ) ParamData%NnodesForceTower = ParamData%C_obj%NnodesForceTower ! -- forceBldRnodes Param Data fields - IF ( .NOT. C_ASSOCIATED( ParamData%C_obj%forceBldRnodes ) ) THEN - NULLIFY( ParamData%forceBldRnodes ) - ELSE - CALL C_F_POINTER(ParamData%C_obj%forceBldRnodes, ParamData%forceBldRnodes, (/ParamData%C_obj%forceBldRnodes_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ParamData%C_obj%forceBldRnodes ) ) THEN + NULLIFY( ParamData%forceBldRnodes ) + ELSE + CALL C_F_POINTER(ParamData%C_obj%forceBldRnodes, ParamData%forceBldRnodes, (/ParamData%C_obj%forceBldRnodes_Len/)) + END IF END IF ! -- forceTwrHnodes Param Data fields - IF ( .NOT. C_ASSOCIATED( ParamData%C_obj%forceTwrHnodes ) ) THEN - NULLIFY( ParamData%forceTwrHnodes ) - ELSE - CALL C_F_POINTER(ParamData%C_obj%forceTwrHnodes, ParamData%forceTwrHnodes, (/ParamData%C_obj%forceTwrHnodes_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( ParamData%C_obj%forceTwrHnodes ) ) THEN + NULLIFY( ParamData%forceTwrHnodes ) + ELSE + CALL C_F_POINTER(ParamData%C_obj%forceTwrHnodes, ParamData%forceTwrHnodes, (/ParamData%C_obj%forceTwrHnodes_Len/)) + END IF END IF ParamData%BladeLength = ParamData%C_obj%BladeLength ParamData%TowerHeight = ParamData%C_obj%TowerHeight ParamData%TowerBaseHeight = ParamData%C_obj%TowerBaseHeight END SUBROUTINE OpFM_C2Fary_CopyParam + SUBROUTINE OpFM_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) + TYPE(OpFM_ParameterType), INTENT(INOUT) :: ParamData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + ParamData%C_obj%AirDens = ParamData%AirDens + ParamData%C_obj%NumBl = ParamData%NumBl + ParamData%C_obj%NMappings = ParamData%NMappings + ParamData%C_obj%NnodesVel = ParamData%NnodesVel + ParamData%C_obj%NnodesForce = ParamData%NnodesForce + ParamData%C_obj%NnodesForceBlade = ParamData%NnodesForceBlade + ParamData%C_obj%NnodesForceTower = ParamData%NnodesForceTower + + ! -- forceBldRnodes Param Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(ParamData%forceBldRnodes)) THEN + ParamData%c_obj%forceBldRnodes_Len = 0 + ParamData%c_obj%forceBldRnodes = C_NULL_PTR + ELSE + ParamData%c_obj%forceBldRnodes_Len = SIZE(ParamData%forceBldRnodes) + IF (ParamData%c_obj%forceBldRnodes_Len > 0) & + ParamData%c_obj%forceBldRnodes = C_LOC( ParamData%forceBldRnodes( LBOUND(ParamData%forceBldRnodes,1) ) ) + END IF + END IF + + ! -- forceTwrHnodes Param Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(ParamData%forceTwrHnodes)) THEN + ParamData%c_obj%forceTwrHnodes_Len = 0 + ParamData%c_obj%forceTwrHnodes = C_NULL_PTR + ELSE + ParamData%c_obj%forceTwrHnodes_Len = SIZE(ParamData%forceTwrHnodes) + IF (ParamData%c_obj%forceTwrHnodes_Len > 0) & + ParamData%c_obj%forceTwrHnodes = C_LOC( ParamData%forceTwrHnodes( LBOUND(ParamData%forceTwrHnodes,1) ) ) + END IF + END IF + ParamData%C_obj%BladeLength = ParamData%BladeLength + ParamData%C_obj%TowerHeight = ParamData%TowerHeight + ParamData%C_obj%TowerBaseHeight = ParamData%TowerBaseHeight + END SUBROUTINE OpFM_F2C_CopyParam + SUBROUTINE OpFM_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) TYPE(OpFM_InputType), INTENT(IN) :: SrcInputData TYPE(OpFM_InputType), INTENT(INOUT) :: DstInputData @@ -3131,8 +3254,10 @@ SUBROUTINE OpFM_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pxVel,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%pxVel)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%pxVel))-1 ) = PACK(InData%pxVel,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%pxVel) + DO i1 = LBOUND(InData%pxVel,1), UBOUND(InData%pxVel,1) + ReKiBuf(Re_Xferred) = InData%pxVel(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%pyVel) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3144,8 +3269,10 @@ SUBROUTINE OpFM_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pyVel,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%pyVel)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%pyVel))-1 ) = PACK(InData%pyVel,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%pyVel) + DO i1 = LBOUND(InData%pyVel,1), UBOUND(InData%pyVel,1) + ReKiBuf(Re_Xferred) = InData%pyVel(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%pzVel) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3157,8 +3284,10 @@ SUBROUTINE OpFM_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pzVel,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%pzVel)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%pzVel))-1 ) = PACK(InData%pzVel,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%pzVel) + DO i1 = LBOUND(InData%pzVel,1), UBOUND(InData%pzVel,1) + ReKiBuf(Re_Xferred) = InData%pzVel(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%pxForce) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3170,8 +3299,10 @@ SUBROUTINE OpFM_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pxForce,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%pxForce)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%pxForce))-1 ) = PACK(InData%pxForce,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%pxForce) + DO i1 = LBOUND(InData%pxForce,1), UBOUND(InData%pxForce,1) + ReKiBuf(Re_Xferred) = InData%pxForce(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%pyForce) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3183,8 +3314,10 @@ SUBROUTINE OpFM_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pyForce,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%pyForce)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%pyForce))-1 ) = PACK(InData%pyForce,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%pyForce) + DO i1 = LBOUND(InData%pyForce,1), UBOUND(InData%pyForce,1) + ReKiBuf(Re_Xferred) = InData%pyForce(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%pzForce) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3196,8 +3329,10 @@ SUBROUTINE OpFM_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pzForce,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%pzForce)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%pzForce))-1 ) = PACK(InData%pzForce,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%pzForce) + DO i1 = LBOUND(InData%pzForce,1), UBOUND(InData%pzForce,1) + ReKiBuf(Re_Xferred) = InData%pzForce(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%xdotForce) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3209,8 +3344,10 @@ SUBROUTINE OpFM_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xdotForce,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%xdotForce)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%xdotForce))-1 ) = PACK(InData%xdotForce,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%xdotForce) + DO i1 = LBOUND(InData%xdotForce,1), UBOUND(InData%xdotForce,1) + ReKiBuf(Re_Xferred) = InData%xdotForce(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%ydotForce) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3222,8 +3359,10 @@ SUBROUTINE OpFM_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ydotForce,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ydotForce)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%ydotForce))-1 ) = PACK(InData%ydotForce,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%ydotForce) + DO i1 = LBOUND(InData%ydotForce,1), UBOUND(InData%ydotForce,1) + ReKiBuf(Re_Xferred) = InData%ydotForce(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%zdotForce) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3235,8 +3374,10 @@ SUBROUTINE OpFM_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%zdotForce,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%zdotForce)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%zdotForce))-1 ) = PACK(InData%zdotForce,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%zdotForce) + DO i1 = LBOUND(InData%zdotForce,1), UBOUND(InData%zdotForce,1) + ReKiBuf(Re_Xferred) = InData%zdotForce(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%pOrientation) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3248,8 +3389,10 @@ SUBROUTINE OpFM_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%pOrientation,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%pOrientation)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%pOrientation))-1 ) = PACK(InData%pOrientation,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%pOrientation) + DO i1 = LBOUND(InData%pOrientation,1), UBOUND(InData%pOrientation,1) + ReKiBuf(Re_Xferred) = InData%pOrientation(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%fx) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3261,8 +3404,10 @@ SUBROUTINE OpFM_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fx,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%fx)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%fx))-1 ) = PACK(InData%fx,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%fx) + DO i1 = LBOUND(InData%fx,1), UBOUND(InData%fx,1) + ReKiBuf(Re_Xferred) = InData%fx(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%fy) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3274,8 +3419,10 @@ SUBROUTINE OpFM_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fy,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%fy)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%fy))-1 ) = PACK(InData%fy,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%fy) + DO i1 = LBOUND(InData%fy,1), UBOUND(InData%fy,1) + ReKiBuf(Re_Xferred) = InData%fy(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%fz) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3287,8 +3434,10 @@ SUBROUTINE OpFM_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fz,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%fz)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%fz))-1 ) = PACK(InData%fz,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%fz) + DO i1 = LBOUND(InData%fz,1), UBOUND(InData%fz,1) + ReKiBuf(Re_Xferred) = InData%fz(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%momentx) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3300,8 +3449,10 @@ SUBROUTINE OpFM_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%momentx,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%momentx)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%momentx))-1 ) = PACK(InData%momentx,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%momentx) + DO i1 = LBOUND(InData%momentx,1), UBOUND(InData%momentx,1) + ReKiBuf(Re_Xferred) = InData%momentx(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%momenty) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3313,8 +3464,10 @@ SUBROUTINE OpFM_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%momenty,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%momenty)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%momenty))-1 ) = PACK(InData%momenty,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%momenty) + DO i1 = LBOUND(InData%momenty,1), UBOUND(InData%momenty,1) + ReKiBuf(Re_Xferred) = InData%momenty(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%momentz) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3326,8 +3479,10 @@ SUBROUTINE OpFM_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%momentz,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%momentz)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%momentz))-1 ) = PACK(InData%momentz,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%momentz) + DO i1 = LBOUND(InData%momentz,1), UBOUND(InData%momentz,1) + ReKiBuf(Re_Xferred) = InData%momentz(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%forceNodesChord) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3339,8 +3494,10 @@ SUBROUTINE OpFM_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%forceNodesChord,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%forceNodesChord)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%forceNodesChord))-1 ) = PACK(InData%forceNodesChord,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%forceNodesChord) + DO i1 = LBOUND(InData%forceNodesChord,1), UBOUND(InData%forceNodesChord,1) + ReKiBuf(Re_Xferred) = InData%forceNodesChord(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%SuperController) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3352,8 +3509,10 @@ SUBROUTINE OpFM_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SuperController,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%SuperController)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SuperController))-1 ) = PACK(InData%SuperController,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SuperController) + DO i1 = LBOUND(InData%SuperController,1), UBOUND(InData%SuperController,1) + ReKiBuf(Re_Xferred) = InData%SuperController(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE OpFM_PackInput @@ -3370,12 +3529,6 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -3406,15 +3559,10 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs OutData%c_obj%pxVel_Len = SIZE(OutData%pxVel) IF (OutData%c_obj%pxVel_Len > 0) & OutData%c_obj%pxVel = C_LOC( OutData%pxVel(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%pxVel)>0) OutData%pxVel = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%pxVel))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%pxVel) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%pxVel,1), UBOUND(OutData%pxVel,1) + OutData%pxVel(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! pyVel not allocated Int_Xferred = Int_Xferred + 1 @@ -3432,15 +3580,10 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs OutData%c_obj%pyVel_Len = SIZE(OutData%pyVel) IF (OutData%c_obj%pyVel_Len > 0) & OutData%c_obj%pyVel = C_LOC( OutData%pyVel(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%pyVel)>0) OutData%pyVel = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%pyVel))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%pyVel) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%pyVel,1), UBOUND(OutData%pyVel,1) + OutData%pyVel(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! pzVel not allocated Int_Xferred = Int_Xferred + 1 @@ -3458,15 +3601,10 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs OutData%c_obj%pzVel_Len = SIZE(OutData%pzVel) IF (OutData%c_obj%pzVel_Len > 0) & OutData%c_obj%pzVel = C_LOC( OutData%pzVel(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%pzVel)>0) OutData%pzVel = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%pzVel))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%pzVel) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%pzVel,1), UBOUND(OutData%pzVel,1) + OutData%pzVel(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! pxForce not allocated Int_Xferred = Int_Xferred + 1 @@ -3484,15 +3622,10 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs OutData%c_obj%pxForce_Len = SIZE(OutData%pxForce) IF (OutData%c_obj%pxForce_Len > 0) & OutData%c_obj%pxForce = C_LOC( OutData%pxForce(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%pxForce)>0) OutData%pxForce = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%pxForce))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%pxForce) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%pxForce,1), UBOUND(OutData%pxForce,1) + OutData%pxForce(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! pyForce not allocated Int_Xferred = Int_Xferred + 1 @@ -3510,15 +3643,10 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs OutData%c_obj%pyForce_Len = SIZE(OutData%pyForce) IF (OutData%c_obj%pyForce_Len > 0) & OutData%c_obj%pyForce = C_LOC( OutData%pyForce(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%pyForce)>0) OutData%pyForce = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%pyForce))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%pyForce) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%pyForce,1), UBOUND(OutData%pyForce,1) + OutData%pyForce(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! pzForce not allocated Int_Xferred = Int_Xferred + 1 @@ -3536,15 +3664,10 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs OutData%c_obj%pzForce_Len = SIZE(OutData%pzForce) IF (OutData%c_obj%pzForce_Len > 0) & OutData%c_obj%pzForce = C_LOC( OutData%pzForce(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%pzForce)>0) OutData%pzForce = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%pzForce))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%pzForce) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%pzForce,1), UBOUND(OutData%pzForce,1) + OutData%pzForce(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xdotForce not allocated Int_Xferred = Int_Xferred + 1 @@ -3562,15 +3685,10 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs OutData%c_obj%xdotForce_Len = SIZE(OutData%xdotForce) IF (OutData%c_obj%xdotForce_Len > 0) & OutData%c_obj%xdotForce = C_LOC( OutData%xdotForce(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%xdotForce)>0) OutData%xdotForce = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%xdotForce))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%xdotForce) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%xdotForce,1), UBOUND(OutData%xdotForce,1) + OutData%xdotForce(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ydotForce not allocated Int_Xferred = Int_Xferred + 1 @@ -3588,15 +3706,10 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs OutData%c_obj%ydotForce_Len = SIZE(OutData%ydotForce) IF (OutData%c_obj%ydotForce_Len > 0) & OutData%c_obj%ydotForce = C_LOC( OutData%ydotForce(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%ydotForce)>0) OutData%ydotForce = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%ydotForce))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%ydotForce) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%ydotForce,1), UBOUND(OutData%ydotForce,1) + OutData%ydotForce(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! zdotForce not allocated Int_Xferred = Int_Xferred + 1 @@ -3614,15 +3727,10 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs OutData%c_obj%zdotForce_Len = SIZE(OutData%zdotForce) IF (OutData%c_obj%zdotForce_Len > 0) & OutData%c_obj%zdotForce = C_LOC( OutData%zdotForce(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%zdotForce)>0) OutData%zdotForce = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%zdotForce))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%zdotForce) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%zdotForce,1), UBOUND(OutData%zdotForce,1) + OutData%zdotForce(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! pOrientation not allocated Int_Xferred = Int_Xferred + 1 @@ -3640,15 +3748,10 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs OutData%c_obj%pOrientation_Len = SIZE(OutData%pOrientation) IF (OutData%c_obj%pOrientation_Len > 0) & OutData%c_obj%pOrientation = C_LOC( OutData%pOrientation(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%pOrientation)>0) OutData%pOrientation = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%pOrientation))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%pOrientation) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%pOrientation,1), UBOUND(OutData%pOrientation,1) + OutData%pOrientation(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fx not allocated Int_Xferred = Int_Xferred + 1 @@ -3666,15 +3769,10 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs OutData%c_obj%fx_Len = SIZE(OutData%fx) IF (OutData%c_obj%fx_Len > 0) & OutData%c_obj%fx = C_LOC( OutData%fx(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%fx)>0) OutData%fx = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%fx))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%fx) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%fx,1), UBOUND(OutData%fx,1) + OutData%fx(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fy not allocated Int_Xferred = Int_Xferred + 1 @@ -3692,15 +3790,10 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs OutData%c_obj%fy_Len = SIZE(OutData%fy) IF (OutData%c_obj%fy_Len > 0) & OutData%c_obj%fy = C_LOC( OutData%fy(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%fy)>0) OutData%fy = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%fy))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%fy) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%fy,1), UBOUND(OutData%fy,1) + OutData%fy(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! fz not allocated Int_Xferred = Int_Xferred + 1 @@ -3718,15 +3811,10 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs OutData%c_obj%fz_Len = SIZE(OutData%fz) IF (OutData%c_obj%fz_Len > 0) & OutData%c_obj%fz = C_LOC( OutData%fz(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%fz)>0) OutData%fz = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%fz))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%fz) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%fz,1), UBOUND(OutData%fz,1) + OutData%fz(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! momentx not allocated Int_Xferred = Int_Xferred + 1 @@ -3744,15 +3832,10 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs OutData%c_obj%momentx_Len = SIZE(OutData%momentx) IF (OutData%c_obj%momentx_Len > 0) & OutData%c_obj%momentx = C_LOC( OutData%momentx(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%momentx)>0) OutData%momentx = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%momentx))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%momentx) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%momentx,1), UBOUND(OutData%momentx,1) + OutData%momentx(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! momenty not allocated Int_Xferred = Int_Xferred + 1 @@ -3770,15 +3853,10 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs OutData%c_obj%momenty_Len = SIZE(OutData%momenty) IF (OutData%c_obj%momenty_Len > 0) & OutData%c_obj%momenty = C_LOC( OutData%momenty(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%momenty)>0) OutData%momenty = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%momenty))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%momenty) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%momenty,1), UBOUND(OutData%momenty,1) + OutData%momenty(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! momentz not allocated Int_Xferred = Int_Xferred + 1 @@ -3796,15 +3874,10 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs OutData%c_obj%momentz_Len = SIZE(OutData%momentz) IF (OutData%c_obj%momentz_Len > 0) & OutData%c_obj%momentz = C_LOC( OutData%momentz(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%momentz)>0) OutData%momentz = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%momentz))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%momentz) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%momentz,1), UBOUND(OutData%momentz,1) + OutData%momentz(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! forceNodesChord not allocated Int_Xferred = Int_Xferred + 1 @@ -3822,15 +3895,10 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs OutData%c_obj%forceNodesChord_Len = SIZE(OutData%forceNodesChord) IF (OutData%c_obj%forceNodesChord_Len > 0) & OutData%c_obj%forceNodesChord = C_LOC( OutData%forceNodesChord(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%forceNodesChord)>0) OutData%forceNodesChord = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%forceNodesChord))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%forceNodesChord) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%forceNodesChord,1), UBOUND(OutData%forceNodesChord,1) + OutData%forceNodesChord(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SuperController not allocated Int_Xferred = Int_Xferred + 1 @@ -3848,153 +3916,425 @@ SUBROUTINE OpFM_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs OutData%c_obj%SuperController_Len = SIZE(OutData%SuperController) IF (OutData%c_obj%SuperController_Len > 0) & OutData%c_obj%SuperController = C_LOC( OutData%SuperController(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%SuperController)>0) OutData%SuperController = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SuperController))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%SuperController) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%SuperController,1), UBOUND(OutData%SuperController,1) + OutData%SuperController(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE OpFM_UnPackInput - SUBROUTINE OpFM_C2Fary_CopyInput( InputData, ErrStat, ErrMsg ) + SUBROUTINE OpFM_C2Fary_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) TYPE(OpFM_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" - ! -- pxVel Input Data fields - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pxVel ) ) THEN - NULLIFY( InputData%pxVel ) + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers ELSE - CALL C_F_POINTER(InputData%C_obj%pxVel, InputData%pxVel, (/InputData%C_obj%pxVel_Len/)) + SkipPointers_local = .false. + END IF + + ! -- pxVel Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pxVel ) ) THEN + NULLIFY( InputData%pxVel ) + ELSE + CALL C_F_POINTER(InputData%C_obj%pxVel, InputData%pxVel, (/InputData%C_obj%pxVel_Len/)) + END IF END IF ! -- pyVel Input Data fields - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pyVel ) ) THEN - NULLIFY( InputData%pyVel ) - ELSE - CALL C_F_POINTER(InputData%C_obj%pyVel, InputData%pyVel, (/InputData%C_obj%pyVel_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pyVel ) ) THEN + NULLIFY( InputData%pyVel ) + ELSE + CALL C_F_POINTER(InputData%C_obj%pyVel, InputData%pyVel, (/InputData%C_obj%pyVel_Len/)) + END IF END IF ! -- pzVel Input Data fields - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pzVel ) ) THEN - NULLIFY( InputData%pzVel ) - ELSE - CALL C_F_POINTER(InputData%C_obj%pzVel, InputData%pzVel, (/InputData%C_obj%pzVel_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pzVel ) ) THEN + NULLIFY( InputData%pzVel ) + ELSE + CALL C_F_POINTER(InputData%C_obj%pzVel, InputData%pzVel, (/InputData%C_obj%pzVel_Len/)) + END IF END IF ! -- pxForce Input Data fields - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pxForce ) ) THEN - NULLIFY( InputData%pxForce ) - ELSE - CALL C_F_POINTER(InputData%C_obj%pxForce, InputData%pxForce, (/InputData%C_obj%pxForce_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pxForce ) ) THEN + NULLIFY( InputData%pxForce ) + ELSE + CALL C_F_POINTER(InputData%C_obj%pxForce, InputData%pxForce, (/InputData%C_obj%pxForce_Len/)) + END IF END IF ! -- pyForce Input Data fields - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pyForce ) ) THEN - NULLIFY( InputData%pyForce ) - ELSE - CALL C_F_POINTER(InputData%C_obj%pyForce, InputData%pyForce, (/InputData%C_obj%pyForce_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pyForce ) ) THEN + NULLIFY( InputData%pyForce ) + ELSE + CALL C_F_POINTER(InputData%C_obj%pyForce, InputData%pyForce, (/InputData%C_obj%pyForce_Len/)) + END IF END IF ! -- pzForce Input Data fields - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pzForce ) ) THEN - NULLIFY( InputData%pzForce ) - ELSE - CALL C_F_POINTER(InputData%C_obj%pzForce, InputData%pzForce, (/InputData%C_obj%pzForce_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pzForce ) ) THEN + NULLIFY( InputData%pzForce ) + ELSE + CALL C_F_POINTER(InputData%C_obj%pzForce, InputData%pzForce, (/InputData%C_obj%pzForce_Len/)) + END IF END IF ! -- xdotForce Input Data fields - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%xdotForce ) ) THEN - NULLIFY( InputData%xdotForce ) - ELSE - CALL C_F_POINTER(InputData%C_obj%xdotForce, InputData%xdotForce, (/InputData%C_obj%xdotForce_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%xdotForce ) ) THEN + NULLIFY( InputData%xdotForce ) + ELSE + CALL C_F_POINTER(InputData%C_obj%xdotForce, InputData%xdotForce, (/InputData%C_obj%xdotForce_Len/)) + END IF END IF ! -- ydotForce Input Data fields - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%ydotForce ) ) THEN - NULLIFY( InputData%ydotForce ) - ELSE - CALL C_F_POINTER(InputData%C_obj%ydotForce, InputData%ydotForce, (/InputData%C_obj%ydotForce_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%ydotForce ) ) THEN + NULLIFY( InputData%ydotForce ) + ELSE + CALL C_F_POINTER(InputData%C_obj%ydotForce, InputData%ydotForce, (/InputData%C_obj%ydotForce_Len/)) + END IF END IF ! -- zdotForce Input Data fields - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%zdotForce ) ) THEN - NULLIFY( InputData%zdotForce ) - ELSE - CALL C_F_POINTER(InputData%C_obj%zdotForce, InputData%zdotForce, (/InputData%C_obj%zdotForce_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%zdotForce ) ) THEN + NULLIFY( InputData%zdotForce ) + ELSE + CALL C_F_POINTER(InputData%C_obj%zdotForce, InputData%zdotForce, (/InputData%C_obj%zdotForce_Len/)) + END IF END IF ! -- pOrientation Input Data fields - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pOrientation ) ) THEN - NULLIFY( InputData%pOrientation ) - ELSE - CALL C_F_POINTER(InputData%C_obj%pOrientation, InputData%pOrientation, (/InputData%C_obj%pOrientation_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%pOrientation ) ) THEN + NULLIFY( InputData%pOrientation ) + ELSE + CALL C_F_POINTER(InputData%C_obj%pOrientation, InputData%pOrientation, (/InputData%C_obj%pOrientation_Len/)) + END IF END IF ! -- fx Input Data fields - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%fx ) ) THEN - NULLIFY( InputData%fx ) - ELSE - CALL C_F_POINTER(InputData%C_obj%fx, InputData%fx, (/InputData%C_obj%fx_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%fx ) ) THEN + NULLIFY( InputData%fx ) + ELSE + CALL C_F_POINTER(InputData%C_obj%fx, InputData%fx, (/InputData%C_obj%fx_Len/)) + END IF END IF ! -- fy Input Data fields - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%fy ) ) THEN - NULLIFY( InputData%fy ) - ELSE - CALL C_F_POINTER(InputData%C_obj%fy, InputData%fy, (/InputData%C_obj%fy_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%fy ) ) THEN + NULLIFY( InputData%fy ) + ELSE + CALL C_F_POINTER(InputData%C_obj%fy, InputData%fy, (/InputData%C_obj%fy_Len/)) + END IF END IF ! -- fz Input Data fields - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%fz ) ) THEN - NULLIFY( InputData%fz ) - ELSE - CALL C_F_POINTER(InputData%C_obj%fz, InputData%fz, (/InputData%C_obj%fz_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%fz ) ) THEN + NULLIFY( InputData%fz ) + ELSE + CALL C_F_POINTER(InputData%C_obj%fz, InputData%fz, (/InputData%C_obj%fz_Len/)) + END IF END IF ! -- momentx Input Data fields - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%momentx ) ) THEN - NULLIFY( InputData%momentx ) - ELSE - CALL C_F_POINTER(InputData%C_obj%momentx, InputData%momentx, (/InputData%C_obj%momentx_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%momentx ) ) THEN + NULLIFY( InputData%momentx ) + ELSE + CALL C_F_POINTER(InputData%C_obj%momentx, InputData%momentx, (/InputData%C_obj%momentx_Len/)) + END IF END IF ! -- momenty Input Data fields - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%momenty ) ) THEN - NULLIFY( InputData%momenty ) - ELSE - CALL C_F_POINTER(InputData%C_obj%momenty, InputData%momenty, (/InputData%C_obj%momenty_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%momenty ) ) THEN + NULLIFY( InputData%momenty ) + ELSE + CALL C_F_POINTER(InputData%C_obj%momenty, InputData%momenty, (/InputData%C_obj%momenty_Len/)) + END IF END IF ! -- momentz Input Data fields - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%momentz ) ) THEN - NULLIFY( InputData%momentz ) - ELSE - CALL C_F_POINTER(InputData%C_obj%momentz, InputData%momentz, (/InputData%C_obj%momentz_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%momentz ) ) THEN + NULLIFY( InputData%momentz ) + ELSE + CALL C_F_POINTER(InputData%C_obj%momentz, InputData%momentz, (/InputData%C_obj%momentz_Len/)) + END IF END IF ! -- forceNodesChord Input Data fields - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%forceNodesChord ) ) THEN - NULLIFY( InputData%forceNodesChord ) - ELSE - CALL C_F_POINTER(InputData%C_obj%forceNodesChord, InputData%forceNodesChord, (/InputData%C_obj%forceNodesChord_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%forceNodesChord ) ) THEN + NULLIFY( InputData%forceNodesChord ) + ELSE + CALL C_F_POINTER(InputData%C_obj%forceNodesChord, InputData%forceNodesChord, (/InputData%C_obj%forceNodesChord_Len/)) + END IF END IF ! -- SuperController Input Data fields - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%SuperController ) ) THEN - NULLIFY( InputData%SuperController ) - ELSE - CALL C_F_POINTER(InputData%C_obj%SuperController, InputData%SuperController, (/InputData%C_obj%SuperController_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%SuperController ) ) THEN + NULLIFY( InputData%SuperController ) + ELSE + CALL C_F_POINTER(InputData%C_obj%SuperController, InputData%SuperController, (/InputData%C_obj%SuperController_Len/)) + END IF END IF END SUBROUTINE OpFM_C2Fary_CopyInput + SUBROUTINE OpFM_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(OpFM_InputType), INTENT(INOUT) :: InputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + + ! -- pxVel Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%pxVel)) THEN + InputData%c_obj%pxVel_Len = 0 + InputData%c_obj%pxVel = C_NULL_PTR + ELSE + InputData%c_obj%pxVel_Len = SIZE(InputData%pxVel) + IF (InputData%c_obj%pxVel_Len > 0) & + InputData%c_obj%pxVel = C_LOC( InputData%pxVel( LBOUND(InputData%pxVel,1) ) ) + END IF + END IF + + ! -- pyVel Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%pyVel)) THEN + InputData%c_obj%pyVel_Len = 0 + InputData%c_obj%pyVel = C_NULL_PTR + ELSE + InputData%c_obj%pyVel_Len = SIZE(InputData%pyVel) + IF (InputData%c_obj%pyVel_Len > 0) & + InputData%c_obj%pyVel = C_LOC( InputData%pyVel( LBOUND(InputData%pyVel,1) ) ) + END IF + END IF + + ! -- pzVel Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%pzVel)) THEN + InputData%c_obj%pzVel_Len = 0 + InputData%c_obj%pzVel = C_NULL_PTR + ELSE + InputData%c_obj%pzVel_Len = SIZE(InputData%pzVel) + IF (InputData%c_obj%pzVel_Len > 0) & + InputData%c_obj%pzVel = C_LOC( InputData%pzVel( LBOUND(InputData%pzVel,1) ) ) + END IF + END IF + + ! -- pxForce Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%pxForce)) THEN + InputData%c_obj%pxForce_Len = 0 + InputData%c_obj%pxForce = C_NULL_PTR + ELSE + InputData%c_obj%pxForce_Len = SIZE(InputData%pxForce) + IF (InputData%c_obj%pxForce_Len > 0) & + InputData%c_obj%pxForce = C_LOC( InputData%pxForce( LBOUND(InputData%pxForce,1) ) ) + END IF + END IF + + ! -- pyForce Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%pyForce)) THEN + InputData%c_obj%pyForce_Len = 0 + InputData%c_obj%pyForce = C_NULL_PTR + ELSE + InputData%c_obj%pyForce_Len = SIZE(InputData%pyForce) + IF (InputData%c_obj%pyForce_Len > 0) & + InputData%c_obj%pyForce = C_LOC( InputData%pyForce( LBOUND(InputData%pyForce,1) ) ) + END IF + END IF + + ! -- pzForce Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%pzForce)) THEN + InputData%c_obj%pzForce_Len = 0 + InputData%c_obj%pzForce = C_NULL_PTR + ELSE + InputData%c_obj%pzForce_Len = SIZE(InputData%pzForce) + IF (InputData%c_obj%pzForce_Len > 0) & + InputData%c_obj%pzForce = C_LOC( InputData%pzForce( LBOUND(InputData%pzForce,1) ) ) + END IF + END IF + + ! -- xdotForce Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%xdotForce)) THEN + InputData%c_obj%xdotForce_Len = 0 + InputData%c_obj%xdotForce = C_NULL_PTR + ELSE + InputData%c_obj%xdotForce_Len = SIZE(InputData%xdotForce) + IF (InputData%c_obj%xdotForce_Len > 0) & + InputData%c_obj%xdotForce = C_LOC( InputData%xdotForce( LBOUND(InputData%xdotForce,1) ) ) + END IF + END IF + + ! -- ydotForce Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%ydotForce)) THEN + InputData%c_obj%ydotForce_Len = 0 + InputData%c_obj%ydotForce = C_NULL_PTR + ELSE + InputData%c_obj%ydotForce_Len = SIZE(InputData%ydotForce) + IF (InputData%c_obj%ydotForce_Len > 0) & + InputData%c_obj%ydotForce = C_LOC( InputData%ydotForce( LBOUND(InputData%ydotForce,1) ) ) + END IF + END IF + + ! -- zdotForce Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%zdotForce)) THEN + InputData%c_obj%zdotForce_Len = 0 + InputData%c_obj%zdotForce = C_NULL_PTR + ELSE + InputData%c_obj%zdotForce_Len = SIZE(InputData%zdotForce) + IF (InputData%c_obj%zdotForce_Len > 0) & + InputData%c_obj%zdotForce = C_LOC( InputData%zdotForce( LBOUND(InputData%zdotForce,1) ) ) + END IF + END IF + + ! -- pOrientation Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%pOrientation)) THEN + InputData%c_obj%pOrientation_Len = 0 + InputData%c_obj%pOrientation = C_NULL_PTR + ELSE + InputData%c_obj%pOrientation_Len = SIZE(InputData%pOrientation) + IF (InputData%c_obj%pOrientation_Len > 0) & + InputData%c_obj%pOrientation = C_LOC( InputData%pOrientation( LBOUND(InputData%pOrientation,1) ) ) + END IF + END IF + + ! -- fx Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%fx)) THEN + InputData%c_obj%fx_Len = 0 + InputData%c_obj%fx = C_NULL_PTR + ELSE + InputData%c_obj%fx_Len = SIZE(InputData%fx) + IF (InputData%c_obj%fx_Len > 0) & + InputData%c_obj%fx = C_LOC( InputData%fx( LBOUND(InputData%fx,1) ) ) + END IF + END IF + + ! -- fy Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%fy)) THEN + InputData%c_obj%fy_Len = 0 + InputData%c_obj%fy = C_NULL_PTR + ELSE + InputData%c_obj%fy_Len = SIZE(InputData%fy) + IF (InputData%c_obj%fy_Len > 0) & + InputData%c_obj%fy = C_LOC( InputData%fy( LBOUND(InputData%fy,1) ) ) + END IF + END IF + + ! -- fz Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%fz)) THEN + InputData%c_obj%fz_Len = 0 + InputData%c_obj%fz = C_NULL_PTR + ELSE + InputData%c_obj%fz_Len = SIZE(InputData%fz) + IF (InputData%c_obj%fz_Len > 0) & + InputData%c_obj%fz = C_LOC( InputData%fz( LBOUND(InputData%fz,1) ) ) + END IF + END IF + + ! -- momentx Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%momentx)) THEN + InputData%c_obj%momentx_Len = 0 + InputData%c_obj%momentx = C_NULL_PTR + ELSE + InputData%c_obj%momentx_Len = SIZE(InputData%momentx) + IF (InputData%c_obj%momentx_Len > 0) & + InputData%c_obj%momentx = C_LOC( InputData%momentx( LBOUND(InputData%momentx,1) ) ) + END IF + END IF + + ! -- momenty Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%momenty)) THEN + InputData%c_obj%momenty_Len = 0 + InputData%c_obj%momenty = C_NULL_PTR + ELSE + InputData%c_obj%momenty_Len = SIZE(InputData%momenty) + IF (InputData%c_obj%momenty_Len > 0) & + InputData%c_obj%momenty = C_LOC( InputData%momenty( LBOUND(InputData%momenty,1) ) ) + END IF + END IF + + ! -- momentz Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%momentz)) THEN + InputData%c_obj%momentz_Len = 0 + InputData%c_obj%momentz = C_NULL_PTR + ELSE + InputData%c_obj%momentz_Len = SIZE(InputData%momentz) + IF (InputData%c_obj%momentz_Len > 0) & + InputData%c_obj%momentz = C_LOC( InputData%momentz( LBOUND(InputData%momentz,1) ) ) + END IF + END IF + + ! -- forceNodesChord Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%forceNodesChord)) THEN + InputData%c_obj%forceNodesChord_Len = 0 + InputData%c_obj%forceNodesChord = C_NULL_PTR + ELSE + InputData%c_obj%forceNodesChord_Len = SIZE(InputData%forceNodesChord) + IF (InputData%c_obj%forceNodesChord_Len > 0) & + InputData%c_obj%forceNodesChord = C_LOC( InputData%forceNodesChord( LBOUND(InputData%forceNodesChord,1) ) ) + END IF + END IF + + ! -- SuperController Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%SuperController)) THEN + InputData%c_obj%SuperController_Len = 0 + InputData%c_obj%SuperController = C_NULL_PTR + ELSE + InputData%c_obj%SuperController_Len = SIZE(InputData%SuperController) + IF (InputData%c_obj%SuperController_Len > 0) & + InputData%c_obj%SuperController = C_LOC( InputData%SuperController( LBOUND(InputData%SuperController,1) ) ) + END IF + END IF + END SUBROUTINE OpFM_F2C_CopyInput + SUBROUTINE OpFM_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(OpFM_OutputType), INTENT(IN) :: SrcOutputData TYPE(OpFM_OutputType), INTENT(INOUT) :: DstOutputData @@ -4081,7 +4421,6 @@ SUBROUTINE OpFM_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, Err END IF END IF DstOutputData%WriteOutput = SrcOutputData%WriteOutput - DstOutputData%C_obj%WriteOutput = SrcOutputData%C_obj%WriteOutput ENDIF END SUBROUTINE OpFM_CopyOutput @@ -4222,8 +4561,10 @@ SUBROUTINE OpFM_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%u,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%u)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%u))-1 ) = PACK(InData%u,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%u) + DO i1 = LBOUND(InData%u,1), UBOUND(InData%u,1) + ReKiBuf(Re_Xferred) = InData%u(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%v) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4235,8 +4576,10 @@ SUBROUTINE OpFM_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%v,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%v)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%v))-1 ) = PACK(InData%v,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%v) + DO i1 = LBOUND(InData%v,1), UBOUND(InData%v,1) + ReKiBuf(Re_Xferred) = InData%v(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%w) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4248,8 +4591,10 @@ SUBROUTINE OpFM_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%w,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%w)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%w))-1 ) = PACK(InData%w,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%w) + DO i1 = LBOUND(InData%w,1), UBOUND(InData%w,1) + ReKiBuf(Re_Xferred) = InData%w(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ASSOCIATED(InData%SuperController) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4261,8 +4606,10 @@ SUBROUTINE OpFM_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SuperController,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%SuperController)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SuperController))-1 ) = PACK(InData%SuperController,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SuperController) + DO i1 = LBOUND(InData%SuperController,1), UBOUND(InData%SuperController,1) + ReKiBuf(Re_Xferred) = InData%SuperController(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutput) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4274,8 +4621,10 @@ SUBROUTINE OpFM_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WriteOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WriteOutput))-1 ) = PACK(InData%WriteOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WriteOutput) + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE OpFM_PackOutput @@ -4292,12 +4641,6 @@ SUBROUTINE OpFM_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -4328,15 +4671,10 @@ SUBROUTINE OpFM_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM OutData%c_obj%u_Len = SIZE(OutData%u) IF (OutData%c_obj%u_Len > 0) & OutData%c_obj%u = C_LOC( OutData%u(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%u)>0) OutData%u = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%u))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%u) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%u,1), UBOUND(OutData%u,1) + OutData%u(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! v not allocated Int_Xferred = Int_Xferred + 1 @@ -4354,15 +4692,10 @@ SUBROUTINE OpFM_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM OutData%c_obj%v_Len = SIZE(OutData%v) IF (OutData%c_obj%v_Len > 0) & OutData%c_obj%v = C_LOC( OutData%v(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%v)>0) OutData%v = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%v))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%v) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%v,1), UBOUND(OutData%v,1) + OutData%v(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! w not allocated Int_Xferred = Int_Xferred + 1 @@ -4380,15 +4713,10 @@ SUBROUTINE OpFM_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM OutData%c_obj%w_Len = SIZE(OutData%w) IF (OutData%c_obj%w_Len > 0) & OutData%c_obj%w = C_LOC( OutData%w(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%w)>0) OutData%w = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%w))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%w) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%w,1), UBOUND(OutData%w,1) + OutData%w(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SuperController not allocated Int_Xferred = Int_Xferred + 1 @@ -4406,15 +4734,10 @@ SUBROUTINE OpFM_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM OutData%c_obj%SuperController_Len = SIZE(OutData%SuperController) IF (OutData%c_obj%SuperController_Len > 0) & OutData%c_obj%SuperController = C_LOC( OutData%SuperController(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%SuperController)>0) OutData%SuperController = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SuperController))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%SuperController) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%SuperController,1), UBOUND(OutData%SuperController,1) + OutData%SuperController(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutput not allocated Int_Xferred = Int_Xferred + 1 @@ -4429,55 +4752,131 @@ SUBROUTINE OpFM_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WriteOutput)>0) OutData%WriteOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WriteOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WriteOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE OpFM_UnPackOutput - SUBROUTINE OpFM_C2Fary_CopyOutput( OutputData, ErrStat, ErrMsg ) + SUBROUTINE OpFM_C2Fary_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) TYPE(OpFM_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" - ! -- u Output Data fields - IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%u ) ) THEN - NULLIFY( OutputData%u ) + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers ELSE - CALL C_F_POINTER(OutputData%C_obj%u, OutputData%u, (/OutputData%C_obj%u_Len/)) + SkipPointers_local = .false. + END IF + + ! -- u Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%u ) ) THEN + NULLIFY( OutputData%u ) + ELSE + CALL C_F_POINTER(OutputData%C_obj%u, OutputData%u, (/OutputData%C_obj%u_Len/)) + END IF END IF ! -- v Output Data fields - IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%v ) ) THEN - NULLIFY( OutputData%v ) - ELSE - CALL C_F_POINTER(OutputData%C_obj%v, OutputData%v, (/OutputData%C_obj%v_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%v ) ) THEN + NULLIFY( OutputData%v ) + ELSE + CALL C_F_POINTER(OutputData%C_obj%v, OutputData%v, (/OutputData%C_obj%v_Len/)) + END IF END IF ! -- w Output Data fields - IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%w ) ) THEN - NULLIFY( OutputData%w ) - ELSE - CALL C_F_POINTER(OutputData%C_obj%w, OutputData%w, (/OutputData%C_obj%w_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%w ) ) THEN + NULLIFY( OutputData%w ) + ELSE + CALL C_F_POINTER(OutputData%C_obj%w, OutputData%w, (/OutputData%C_obj%w_Len/)) + END IF END IF ! -- SuperController Output Data fields - IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%SuperController ) ) THEN - NULLIFY( OutputData%SuperController ) - ELSE - CALL C_F_POINTER(OutputData%C_obj%SuperController, OutputData%SuperController, (/OutputData%C_obj%SuperController_Len/)) + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%SuperController ) ) THEN + NULLIFY( OutputData%SuperController ) + ELSE + CALL C_F_POINTER(OutputData%C_obj%SuperController, OutputData%SuperController, (/OutputData%C_obj%SuperController_Len/)) + END IF END IF END SUBROUTINE OpFM_C2Fary_CopyOutput + SUBROUTINE OpFM_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(OpFM_OutputType), INTENT(INOUT) :: OutputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + + ! -- u Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OutputData%u)) THEN + OutputData%c_obj%u_Len = 0 + OutputData%c_obj%u = C_NULL_PTR + ELSE + OutputData%c_obj%u_Len = SIZE(OutputData%u) + IF (OutputData%c_obj%u_Len > 0) & + OutputData%c_obj%u = C_LOC( OutputData%u( LBOUND(OutputData%u,1) ) ) + END IF + END IF + + ! -- v Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OutputData%v)) THEN + OutputData%c_obj%v_Len = 0 + OutputData%c_obj%v = C_NULL_PTR + ELSE + OutputData%c_obj%v_Len = SIZE(OutputData%v) + IF (OutputData%c_obj%v_Len > 0) & + OutputData%c_obj%v = C_LOC( OutputData%v( LBOUND(OutputData%v,1) ) ) + END IF + END IF + + ! -- w Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OutputData%w)) THEN + OutputData%c_obj%w_Len = 0 + OutputData%c_obj%w = C_NULL_PTR + ELSE + OutputData%c_obj%w_Len = SIZE(OutputData%w) + IF (OutputData%c_obj%w_Len > 0) & + OutputData%c_obj%w = C_LOC( OutputData%w( LBOUND(OutputData%w,1) ) ) + END IF + END IF + + ! -- SuperController Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OutputData%SuperController)) THEN + OutputData%c_obj%SuperController_Len = 0 + OutputData%c_obj%SuperController = C_NULL_PTR + ELSE + OutputData%c_obj%SuperController_Len = SIZE(OutputData%SuperController) + IF (OutputData%c_obj%SuperController_Len > 0) & + OutputData%c_obj%SuperController = C_LOC( OutputData%SuperController( LBOUND(OutputData%SuperController,1) ) ) + END IF + END IF + END SUBROUTINE OpFM_F2C_CopyOutput + SUBROUTINE OpFM_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) ! @@ -4553,12 +4952,12 @@ SUBROUTINE OpFM_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -4571,149 +4970,115 @@ SUBROUTINE OpFM_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) IF (ASSOCIATED(u_out%pxVel) .AND. ASSOCIATED(u1%pxVel)) THEN - ALLOCATE(b1(SIZE(u_out%pxVel,1))) - ALLOCATE(c1(SIZE(u_out%pxVel,1))) - b1 = -(u1%pxVel - u2%pxVel)/t(2) - u_out%pxVel = u1%pxVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%pxVel,1),UBOUND(u_out%pxVel,1) + b = -(u1%pxVel(i1) - u2%pxVel(i1)) + u_out%pxVel(i1) = u1%pxVel(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%pyVel) .AND. ASSOCIATED(u1%pyVel)) THEN - ALLOCATE(b1(SIZE(u_out%pyVel,1))) - ALLOCATE(c1(SIZE(u_out%pyVel,1))) - b1 = -(u1%pyVel - u2%pyVel)/t(2) - u_out%pyVel = u1%pyVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%pyVel,1),UBOUND(u_out%pyVel,1) + b = -(u1%pyVel(i1) - u2%pyVel(i1)) + u_out%pyVel(i1) = u1%pyVel(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%pzVel) .AND. ASSOCIATED(u1%pzVel)) THEN - ALLOCATE(b1(SIZE(u_out%pzVel,1))) - ALLOCATE(c1(SIZE(u_out%pzVel,1))) - b1 = -(u1%pzVel - u2%pzVel)/t(2) - u_out%pzVel = u1%pzVel + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%pzVel,1),UBOUND(u_out%pzVel,1) + b = -(u1%pzVel(i1) - u2%pzVel(i1)) + u_out%pzVel(i1) = u1%pzVel(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%pxForce) .AND. ASSOCIATED(u1%pxForce)) THEN - ALLOCATE(b1(SIZE(u_out%pxForce,1))) - ALLOCATE(c1(SIZE(u_out%pxForce,1))) - b1 = -(u1%pxForce - u2%pxForce)/t(2) - u_out%pxForce = u1%pxForce + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%pxForce,1),UBOUND(u_out%pxForce,1) + b = -(u1%pxForce(i1) - u2%pxForce(i1)) + u_out%pxForce(i1) = u1%pxForce(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%pyForce) .AND. ASSOCIATED(u1%pyForce)) THEN - ALLOCATE(b1(SIZE(u_out%pyForce,1))) - ALLOCATE(c1(SIZE(u_out%pyForce,1))) - b1 = -(u1%pyForce - u2%pyForce)/t(2) - u_out%pyForce = u1%pyForce + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%pyForce,1),UBOUND(u_out%pyForce,1) + b = -(u1%pyForce(i1) - u2%pyForce(i1)) + u_out%pyForce(i1) = u1%pyForce(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%pzForce) .AND. ASSOCIATED(u1%pzForce)) THEN - ALLOCATE(b1(SIZE(u_out%pzForce,1))) - ALLOCATE(c1(SIZE(u_out%pzForce,1))) - b1 = -(u1%pzForce - u2%pzForce)/t(2) - u_out%pzForce = u1%pzForce + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%pzForce,1),UBOUND(u_out%pzForce,1) + b = -(u1%pzForce(i1) - u2%pzForce(i1)) + u_out%pzForce(i1) = u1%pzForce(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%xdotForce) .AND. ASSOCIATED(u1%xdotForce)) THEN - ALLOCATE(b1(SIZE(u_out%xdotForce,1))) - ALLOCATE(c1(SIZE(u_out%xdotForce,1))) - b1 = -(u1%xdotForce - u2%xdotForce)/t(2) - u_out%xdotForce = u1%xdotForce + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%xdotForce,1),UBOUND(u_out%xdotForce,1) + b = -(u1%xdotForce(i1) - u2%xdotForce(i1)) + u_out%xdotForce(i1) = u1%xdotForce(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%ydotForce) .AND. ASSOCIATED(u1%ydotForce)) THEN - ALLOCATE(b1(SIZE(u_out%ydotForce,1))) - ALLOCATE(c1(SIZE(u_out%ydotForce,1))) - b1 = -(u1%ydotForce - u2%ydotForce)/t(2) - u_out%ydotForce = u1%ydotForce + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%ydotForce,1),UBOUND(u_out%ydotForce,1) + b = -(u1%ydotForce(i1) - u2%ydotForce(i1)) + u_out%ydotForce(i1) = u1%ydotForce(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%zdotForce) .AND. ASSOCIATED(u1%zdotForce)) THEN - ALLOCATE(b1(SIZE(u_out%zdotForce,1))) - ALLOCATE(c1(SIZE(u_out%zdotForce,1))) - b1 = -(u1%zdotForce - u2%zdotForce)/t(2) - u_out%zdotForce = u1%zdotForce + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%zdotForce,1),UBOUND(u_out%zdotForce,1) + b = -(u1%zdotForce(i1) - u2%zdotForce(i1)) + u_out%zdotForce(i1) = u1%zdotForce(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%pOrientation) .AND. ASSOCIATED(u1%pOrientation)) THEN - ALLOCATE(b1(SIZE(u_out%pOrientation,1))) - ALLOCATE(c1(SIZE(u_out%pOrientation,1))) - b1 = -(u1%pOrientation - u2%pOrientation)/t(2) - u_out%pOrientation = u1%pOrientation + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%pOrientation,1),UBOUND(u_out%pOrientation,1) + b = -(u1%pOrientation(i1) - u2%pOrientation(i1)) + u_out%pOrientation(i1) = u1%pOrientation(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%fx) .AND. ASSOCIATED(u1%fx)) THEN - ALLOCATE(b1(SIZE(u_out%fx,1))) - ALLOCATE(c1(SIZE(u_out%fx,1))) - b1 = -(u1%fx - u2%fx)/t(2) - u_out%fx = u1%fx + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%fx,1),UBOUND(u_out%fx,1) + b = -(u1%fx(i1) - u2%fx(i1)) + u_out%fx(i1) = u1%fx(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%fy) .AND. ASSOCIATED(u1%fy)) THEN - ALLOCATE(b1(SIZE(u_out%fy,1))) - ALLOCATE(c1(SIZE(u_out%fy,1))) - b1 = -(u1%fy - u2%fy)/t(2) - u_out%fy = u1%fy + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%fy,1),UBOUND(u_out%fy,1) + b = -(u1%fy(i1) - u2%fy(i1)) + u_out%fy(i1) = u1%fy(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%fz) .AND. ASSOCIATED(u1%fz)) THEN - ALLOCATE(b1(SIZE(u_out%fz,1))) - ALLOCATE(c1(SIZE(u_out%fz,1))) - b1 = -(u1%fz - u2%fz)/t(2) - u_out%fz = u1%fz + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%fz,1),UBOUND(u_out%fz,1) + b = -(u1%fz(i1) - u2%fz(i1)) + u_out%fz(i1) = u1%fz(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%momentx) .AND. ASSOCIATED(u1%momentx)) THEN - ALLOCATE(b1(SIZE(u_out%momentx,1))) - ALLOCATE(c1(SIZE(u_out%momentx,1))) - b1 = -(u1%momentx - u2%momentx)/t(2) - u_out%momentx = u1%momentx + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%momentx,1),UBOUND(u_out%momentx,1) + b = -(u1%momentx(i1) - u2%momentx(i1)) + u_out%momentx(i1) = u1%momentx(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%momenty) .AND. ASSOCIATED(u1%momenty)) THEN - ALLOCATE(b1(SIZE(u_out%momenty,1))) - ALLOCATE(c1(SIZE(u_out%momenty,1))) - b1 = -(u1%momenty - u2%momenty)/t(2) - u_out%momenty = u1%momenty + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%momenty,1),UBOUND(u_out%momenty,1) + b = -(u1%momenty(i1) - u2%momenty(i1)) + u_out%momenty(i1) = u1%momenty(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%momentz) .AND. ASSOCIATED(u1%momentz)) THEN - ALLOCATE(b1(SIZE(u_out%momentz,1))) - ALLOCATE(c1(SIZE(u_out%momentz,1))) - b1 = -(u1%momentz - u2%momentz)/t(2) - u_out%momentz = u1%momentz + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%momentz,1),UBOUND(u_out%momentz,1) + b = -(u1%momentz(i1) - u2%momentz(i1)) + u_out%momentz(i1) = u1%momentz(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%forceNodesChord) .AND. ASSOCIATED(u1%forceNodesChord)) THEN - ALLOCATE(b1(SIZE(u_out%forceNodesChord,1))) - ALLOCATE(c1(SIZE(u_out%forceNodesChord,1))) - b1 = -(u1%forceNodesChord - u2%forceNodesChord)/t(2) - u_out%forceNodesChord = u1%forceNodesChord + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%forceNodesChord,1),UBOUND(u_out%forceNodesChord,1) + b = -(u1%forceNodesChord(i1) - u2%forceNodesChord(i1)) + u_out%forceNodesChord(i1) = u1%forceNodesChord(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%SuperController) .AND. ASSOCIATED(u1%SuperController)) THEN - ALLOCATE(b1(SIZE(u_out%SuperController,1))) - ALLOCATE(c1(SIZE(u_out%SuperController,1))) - b1 = -(u1%SuperController - u2%SuperController)/t(2) - u_out%SuperController = u1%SuperController + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%SuperController,1),UBOUND(u_out%SuperController,1) + b = -(u1%SuperController(i1) - u2%SuperController(i1)) + u_out%SuperController(i1) = u1%SuperController(i1) + b * ScaleFactor + END DO END IF ! check if allocated END SUBROUTINE OpFM_Input_ExtrapInterp1 @@ -4744,13 +5109,14 @@ SUBROUTINE OpFM_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -4769,167 +5135,133 @@ SUBROUTINE OpFM_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) IF (ASSOCIATED(u_out%pxVel) .AND. ASSOCIATED(u1%pxVel)) THEN - ALLOCATE(b1(SIZE(u_out%pxVel,1))) - ALLOCATE(c1(SIZE(u_out%pxVel,1))) - b1 = (t(3)**2*(u1%pxVel - u2%pxVel) + t(2)**2*(-u1%pxVel + u3%pxVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%pxVel + t(3)*u2%pxVel - t(2)*u3%pxVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%pxVel = u1%pxVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%pxVel,1),UBOUND(u_out%pxVel,1) + b = (t(3)**2*(u1%pxVel(i1) - u2%pxVel(i1)) + t(2)**2*(-u1%pxVel(i1) + u3%pxVel(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%pxVel(i1) + t(3)*u2%pxVel(i1) - t(2)*u3%pxVel(i1) ) * scaleFactor + u_out%pxVel(i1) = u1%pxVel(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%pyVel) .AND. ASSOCIATED(u1%pyVel)) THEN - ALLOCATE(b1(SIZE(u_out%pyVel,1))) - ALLOCATE(c1(SIZE(u_out%pyVel,1))) - b1 = (t(3)**2*(u1%pyVel - u2%pyVel) + t(2)**2*(-u1%pyVel + u3%pyVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%pyVel + t(3)*u2%pyVel - t(2)*u3%pyVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%pyVel = u1%pyVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%pyVel,1),UBOUND(u_out%pyVel,1) + b = (t(3)**2*(u1%pyVel(i1) - u2%pyVel(i1)) + t(2)**2*(-u1%pyVel(i1) + u3%pyVel(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%pyVel(i1) + t(3)*u2%pyVel(i1) - t(2)*u3%pyVel(i1) ) * scaleFactor + u_out%pyVel(i1) = u1%pyVel(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%pzVel) .AND. ASSOCIATED(u1%pzVel)) THEN - ALLOCATE(b1(SIZE(u_out%pzVel,1))) - ALLOCATE(c1(SIZE(u_out%pzVel,1))) - b1 = (t(3)**2*(u1%pzVel - u2%pzVel) + t(2)**2*(-u1%pzVel + u3%pzVel))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%pzVel + t(3)*u2%pzVel - t(2)*u3%pzVel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%pzVel = u1%pzVel + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%pzVel,1),UBOUND(u_out%pzVel,1) + b = (t(3)**2*(u1%pzVel(i1) - u2%pzVel(i1)) + t(2)**2*(-u1%pzVel(i1) + u3%pzVel(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%pzVel(i1) + t(3)*u2%pzVel(i1) - t(2)*u3%pzVel(i1) ) * scaleFactor + u_out%pzVel(i1) = u1%pzVel(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%pxForce) .AND. ASSOCIATED(u1%pxForce)) THEN - ALLOCATE(b1(SIZE(u_out%pxForce,1))) - ALLOCATE(c1(SIZE(u_out%pxForce,1))) - b1 = (t(3)**2*(u1%pxForce - u2%pxForce) + t(2)**2*(-u1%pxForce + u3%pxForce))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%pxForce + t(3)*u2%pxForce - t(2)*u3%pxForce ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%pxForce = u1%pxForce + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%pxForce,1),UBOUND(u_out%pxForce,1) + b = (t(3)**2*(u1%pxForce(i1) - u2%pxForce(i1)) + t(2)**2*(-u1%pxForce(i1) + u3%pxForce(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%pxForce(i1) + t(3)*u2%pxForce(i1) - t(2)*u3%pxForce(i1) ) * scaleFactor + u_out%pxForce(i1) = u1%pxForce(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%pyForce) .AND. ASSOCIATED(u1%pyForce)) THEN - ALLOCATE(b1(SIZE(u_out%pyForce,1))) - ALLOCATE(c1(SIZE(u_out%pyForce,1))) - b1 = (t(3)**2*(u1%pyForce - u2%pyForce) + t(2)**2*(-u1%pyForce + u3%pyForce))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%pyForce + t(3)*u2%pyForce - t(2)*u3%pyForce ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%pyForce = u1%pyForce + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%pyForce,1),UBOUND(u_out%pyForce,1) + b = (t(3)**2*(u1%pyForce(i1) - u2%pyForce(i1)) + t(2)**2*(-u1%pyForce(i1) + u3%pyForce(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%pyForce(i1) + t(3)*u2%pyForce(i1) - t(2)*u3%pyForce(i1) ) * scaleFactor + u_out%pyForce(i1) = u1%pyForce(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%pzForce) .AND. ASSOCIATED(u1%pzForce)) THEN - ALLOCATE(b1(SIZE(u_out%pzForce,1))) - ALLOCATE(c1(SIZE(u_out%pzForce,1))) - b1 = (t(3)**2*(u1%pzForce - u2%pzForce) + t(2)**2*(-u1%pzForce + u3%pzForce))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%pzForce + t(3)*u2%pzForce - t(2)*u3%pzForce ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%pzForce = u1%pzForce + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%pzForce,1),UBOUND(u_out%pzForce,1) + b = (t(3)**2*(u1%pzForce(i1) - u2%pzForce(i1)) + t(2)**2*(-u1%pzForce(i1) + u3%pzForce(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%pzForce(i1) + t(3)*u2%pzForce(i1) - t(2)*u3%pzForce(i1) ) * scaleFactor + u_out%pzForce(i1) = u1%pzForce(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%xdotForce) .AND. ASSOCIATED(u1%xdotForce)) THEN - ALLOCATE(b1(SIZE(u_out%xdotForce,1))) - ALLOCATE(c1(SIZE(u_out%xdotForce,1))) - b1 = (t(3)**2*(u1%xdotForce - u2%xdotForce) + t(2)**2*(-u1%xdotForce + u3%xdotForce))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%xdotForce + t(3)*u2%xdotForce - t(2)*u3%xdotForce ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%xdotForce = u1%xdotForce + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%xdotForce,1),UBOUND(u_out%xdotForce,1) + b = (t(3)**2*(u1%xdotForce(i1) - u2%xdotForce(i1)) + t(2)**2*(-u1%xdotForce(i1) + u3%xdotForce(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%xdotForce(i1) + t(3)*u2%xdotForce(i1) - t(2)*u3%xdotForce(i1) ) * scaleFactor + u_out%xdotForce(i1) = u1%xdotForce(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%ydotForce) .AND. ASSOCIATED(u1%ydotForce)) THEN - ALLOCATE(b1(SIZE(u_out%ydotForce,1))) - ALLOCATE(c1(SIZE(u_out%ydotForce,1))) - b1 = (t(3)**2*(u1%ydotForce - u2%ydotForce) + t(2)**2*(-u1%ydotForce + u3%ydotForce))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%ydotForce + t(3)*u2%ydotForce - t(2)*u3%ydotForce ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%ydotForce = u1%ydotForce + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%ydotForce,1),UBOUND(u_out%ydotForce,1) + b = (t(3)**2*(u1%ydotForce(i1) - u2%ydotForce(i1)) + t(2)**2*(-u1%ydotForce(i1) + u3%ydotForce(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%ydotForce(i1) + t(3)*u2%ydotForce(i1) - t(2)*u3%ydotForce(i1) ) * scaleFactor + u_out%ydotForce(i1) = u1%ydotForce(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%zdotForce) .AND. ASSOCIATED(u1%zdotForce)) THEN - ALLOCATE(b1(SIZE(u_out%zdotForce,1))) - ALLOCATE(c1(SIZE(u_out%zdotForce,1))) - b1 = (t(3)**2*(u1%zdotForce - u2%zdotForce) + t(2)**2*(-u1%zdotForce + u3%zdotForce))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%zdotForce + t(3)*u2%zdotForce - t(2)*u3%zdotForce ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%zdotForce = u1%zdotForce + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%zdotForce,1),UBOUND(u_out%zdotForce,1) + b = (t(3)**2*(u1%zdotForce(i1) - u2%zdotForce(i1)) + t(2)**2*(-u1%zdotForce(i1) + u3%zdotForce(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%zdotForce(i1) + t(3)*u2%zdotForce(i1) - t(2)*u3%zdotForce(i1) ) * scaleFactor + u_out%zdotForce(i1) = u1%zdotForce(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%pOrientation) .AND. ASSOCIATED(u1%pOrientation)) THEN - ALLOCATE(b1(SIZE(u_out%pOrientation,1))) - ALLOCATE(c1(SIZE(u_out%pOrientation,1))) - b1 = (t(3)**2*(u1%pOrientation - u2%pOrientation) + t(2)**2*(-u1%pOrientation + u3%pOrientation))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%pOrientation + t(3)*u2%pOrientation - t(2)*u3%pOrientation ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%pOrientation = u1%pOrientation + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%pOrientation,1),UBOUND(u_out%pOrientation,1) + b = (t(3)**2*(u1%pOrientation(i1) - u2%pOrientation(i1)) + t(2)**2*(-u1%pOrientation(i1) + u3%pOrientation(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%pOrientation(i1) + t(3)*u2%pOrientation(i1) - t(2)*u3%pOrientation(i1) ) * scaleFactor + u_out%pOrientation(i1) = u1%pOrientation(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%fx) .AND. ASSOCIATED(u1%fx)) THEN - ALLOCATE(b1(SIZE(u_out%fx,1))) - ALLOCATE(c1(SIZE(u_out%fx,1))) - b1 = (t(3)**2*(u1%fx - u2%fx) + t(2)**2*(-u1%fx + u3%fx))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%fx + t(3)*u2%fx - t(2)*u3%fx ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%fx = u1%fx + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%fx,1),UBOUND(u_out%fx,1) + b = (t(3)**2*(u1%fx(i1) - u2%fx(i1)) + t(2)**2*(-u1%fx(i1) + u3%fx(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%fx(i1) + t(3)*u2%fx(i1) - t(2)*u3%fx(i1) ) * scaleFactor + u_out%fx(i1) = u1%fx(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%fy) .AND. ASSOCIATED(u1%fy)) THEN - ALLOCATE(b1(SIZE(u_out%fy,1))) - ALLOCATE(c1(SIZE(u_out%fy,1))) - b1 = (t(3)**2*(u1%fy - u2%fy) + t(2)**2*(-u1%fy + u3%fy))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%fy + t(3)*u2%fy - t(2)*u3%fy ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%fy = u1%fy + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%fy,1),UBOUND(u_out%fy,1) + b = (t(3)**2*(u1%fy(i1) - u2%fy(i1)) + t(2)**2*(-u1%fy(i1) + u3%fy(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%fy(i1) + t(3)*u2%fy(i1) - t(2)*u3%fy(i1) ) * scaleFactor + u_out%fy(i1) = u1%fy(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%fz) .AND. ASSOCIATED(u1%fz)) THEN - ALLOCATE(b1(SIZE(u_out%fz,1))) - ALLOCATE(c1(SIZE(u_out%fz,1))) - b1 = (t(3)**2*(u1%fz - u2%fz) + t(2)**2*(-u1%fz + u3%fz))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%fz + t(3)*u2%fz - t(2)*u3%fz ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%fz = u1%fz + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%fz,1),UBOUND(u_out%fz,1) + b = (t(3)**2*(u1%fz(i1) - u2%fz(i1)) + t(2)**2*(-u1%fz(i1) + u3%fz(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%fz(i1) + t(3)*u2%fz(i1) - t(2)*u3%fz(i1) ) * scaleFactor + u_out%fz(i1) = u1%fz(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%momentx) .AND. ASSOCIATED(u1%momentx)) THEN - ALLOCATE(b1(SIZE(u_out%momentx,1))) - ALLOCATE(c1(SIZE(u_out%momentx,1))) - b1 = (t(3)**2*(u1%momentx - u2%momentx) + t(2)**2*(-u1%momentx + u3%momentx))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%momentx + t(3)*u2%momentx - t(2)*u3%momentx ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%momentx = u1%momentx + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%momentx,1),UBOUND(u_out%momentx,1) + b = (t(3)**2*(u1%momentx(i1) - u2%momentx(i1)) + t(2)**2*(-u1%momentx(i1) + u3%momentx(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%momentx(i1) + t(3)*u2%momentx(i1) - t(2)*u3%momentx(i1) ) * scaleFactor + u_out%momentx(i1) = u1%momentx(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%momenty) .AND. ASSOCIATED(u1%momenty)) THEN - ALLOCATE(b1(SIZE(u_out%momenty,1))) - ALLOCATE(c1(SIZE(u_out%momenty,1))) - b1 = (t(3)**2*(u1%momenty - u2%momenty) + t(2)**2*(-u1%momenty + u3%momenty))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%momenty + t(3)*u2%momenty - t(2)*u3%momenty ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%momenty = u1%momenty + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%momenty,1),UBOUND(u_out%momenty,1) + b = (t(3)**2*(u1%momenty(i1) - u2%momenty(i1)) + t(2)**2*(-u1%momenty(i1) + u3%momenty(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%momenty(i1) + t(3)*u2%momenty(i1) - t(2)*u3%momenty(i1) ) * scaleFactor + u_out%momenty(i1) = u1%momenty(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%momentz) .AND. ASSOCIATED(u1%momentz)) THEN - ALLOCATE(b1(SIZE(u_out%momentz,1))) - ALLOCATE(c1(SIZE(u_out%momentz,1))) - b1 = (t(3)**2*(u1%momentz - u2%momentz) + t(2)**2*(-u1%momentz + u3%momentz))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%momentz + t(3)*u2%momentz - t(2)*u3%momentz ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%momentz = u1%momentz + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%momentz,1),UBOUND(u_out%momentz,1) + b = (t(3)**2*(u1%momentz(i1) - u2%momentz(i1)) + t(2)**2*(-u1%momentz(i1) + u3%momentz(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%momentz(i1) + t(3)*u2%momentz(i1) - t(2)*u3%momentz(i1) ) * scaleFactor + u_out%momentz(i1) = u1%momentz(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%forceNodesChord) .AND. ASSOCIATED(u1%forceNodesChord)) THEN - ALLOCATE(b1(SIZE(u_out%forceNodesChord,1))) - ALLOCATE(c1(SIZE(u_out%forceNodesChord,1))) - b1 = (t(3)**2*(u1%forceNodesChord - u2%forceNodesChord) + t(2)**2*(-u1%forceNodesChord + u3%forceNodesChord))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%forceNodesChord + t(3)*u2%forceNodesChord - t(2)*u3%forceNodesChord ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%forceNodesChord = u1%forceNodesChord + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%forceNodesChord,1),UBOUND(u_out%forceNodesChord,1) + b = (t(3)**2*(u1%forceNodesChord(i1) - u2%forceNodesChord(i1)) + t(2)**2*(-u1%forceNodesChord(i1) + u3%forceNodesChord(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%forceNodesChord(i1) + t(3)*u2%forceNodesChord(i1) - t(2)*u3%forceNodesChord(i1) ) * scaleFactor + u_out%forceNodesChord(i1) = u1%forceNodesChord(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(u_out%SuperController) .AND. ASSOCIATED(u1%SuperController)) THEN - ALLOCATE(b1(SIZE(u_out%SuperController,1))) - ALLOCATE(c1(SIZE(u_out%SuperController,1))) - b1 = (t(3)**2*(u1%SuperController - u2%SuperController) + t(2)**2*(-u1%SuperController + u3%SuperController))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%SuperController + t(3)*u2%SuperController - t(2)*u3%SuperController ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%SuperController = u1%SuperController + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%SuperController,1),UBOUND(u_out%SuperController,1) + b = (t(3)**2*(u1%SuperController(i1) - u2%SuperController(i1)) + t(2)**2*(-u1%SuperController(i1) + u3%SuperController(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%SuperController(i1) + t(3)*u2%SuperController(i1) - t(2)*u3%SuperController(i1) ) * scaleFactor + u_out%SuperController(i1) = u1%SuperController(i1) + b + c * t_out + END DO END IF ! check if allocated END SUBROUTINE OpFM_Input_ExtrapInterp2 @@ -5008,12 +5340,12 @@ SUBROUTINE OpFM_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -5026,45 +5358,37 @@ SUBROUTINE OpFM_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) IF (ASSOCIATED(y_out%u) .AND. ASSOCIATED(y1%u)) THEN - ALLOCATE(b1(SIZE(y_out%u,1))) - ALLOCATE(c1(SIZE(y_out%u,1))) - b1 = -(y1%u - y2%u)/t(2) - y_out%u = y1%u + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%u,1),UBOUND(y_out%u,1) + b = -(y1%u(i1) - y2%u(i1)) + y_out%u(i1) = y1%u(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(y_out%v) .AND. ASSOCIATED(y1%v)) THEN - ALLOCATE(b1(SIZE(y_out%v,1))) - ALLOCATE(c1(SIZE(y_out%v,1))) - b1 = -(y1%v - y2%v)/t(2) - y_out%v = y1%v + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%v,1),UBOUND(y_out%v,1) + b = -(y1%v(i1) - y2%v(i1)) + y_out%v(i1) = y1%v(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(y_out%w) .AND. ASSOCIATED(y1%w)) THEN - ALLOCATE(b1(SIZE(y_out%w,1))) - ALLOCATE(c1(SIZE(y_out%w,1))) - b1 = -(y1%w - y2%w)/t(2) - y_out%w = y1%w + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%w,1),UBOUND(y_out%w,1) + b = -(y1%w(i1) - y2%w(i1)) + y_out%w(i1) = y1%w(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ASSOCIATED(y_out%SuperController) .AND. ASSOCIATED(y1%SuperController)) THEN - ALLOCATE(b1(SIZE(y_out%SuperController,1))) - ALLOCATE(c1(SIZE(y_out%SuperController,1))) - b1 = -(y1%SuperController - y2%SuperController)/t(2) - y_out%SuperController = y1%SuperController + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%SuperController,1),UBOUND(y_out%SuperController,1) + b = -(y1%SuperController(i1) - y2%SuperController(i1)) + y_out%SuperController(i1) = y1%SuperController(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = -(y1%WriteOutput - y2%WriteOutput)/t(2) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO END IF ! check if allocated END SUBROUTINE OpFM_Output_ExtrapInterp1 @@ -5095,13 +5419,14 @@ SUBROUTINE OpFM_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'OpFM_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -5120,50 +5445,42 @@ SUBROUTINE OpFM_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) IF (ASSOCIATED(y_out%u) .AND. ASSOCIATED(y1%u)) THEN - ALLOCATE(b1(SIZE(y_out%u,1))) - ALLOCATE(c1(SIZE(y_out%u,1))) - b1 = (t(3)**2*(y1%u - y2%u) + t(2)**2*(-y1%u + y3%u))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%u + t(3)*y2%u - t(2)*y3%u ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%u = y1%u + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%u,1),UBOUND(y_out%u,1) + b = (t(3)**2*(y1%u(i1) - y2%u(i1)) + t(2)**2*(-y1%u(i1) + y3%u(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%u(i1) + t(3)*y2%u(i1) - t(2)*y3%u(i1) ) * scaleFactor + y_out%u(i1) = y1%u(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(y_out%v) .AND. ASSOCIATED(y1%v)) THEN - ALLOCATE(b1(SIZE(y_out%v,1))) - ALLOCATE(c1(SIZE(y_out%v,1))) - b1 = (t(3)**2*(y1%v - y2%v) + t(2)**2*(-y1%v + y3%v))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%v + t(3)*y2%v - t(2)*y3%v ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%v = y1%v + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%v,1),UBOUND(y_out%v,1) + b = (t(3)**2*(y1%v(i1) - y2%v(i1)) + t(2)**2*(-y1%v(i1) + y3%v(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%v(i1) + t(3)*y2%v(i1) - t(2)*y3%v(i1) ) * scaleFactor + y_out%v(i1) = y1%v(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(y_out%w) .AND. ASSOCIATED(y1%w)) THEN - ALLOCATE(b1(SIZE(y_out%w,1))) - ALLOCATE(c1(SIZE(y_out%w,1))) - b1 = (t(3)**2*(y1%w - y2%w) + t(2)**2*(-y1%w + y3%w))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%w + t(3)*y2%w - t(2)*y3%w ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%w = y1%w + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%w,1),UBOUND(y_out%w,1) + b = (t(3)**2*(y1%w(i1) - y2%w(i1)) + t(2)**2*(-y1%w(i1) + y3%w(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%w(i1) + t(3)*y2%w(i1) - t(2)*y3%w(i1) ) * scaleFactor + y_out%w(i1) = y1%w(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ASSOCIATED(y_out%SuperController) .AND. ASSOCIATED(y1%SuperController)) THEN - ALLOCATE(b1(SIZE(y_out%SuperController,1))) - ALLOCATE(c1(SIZE(y_out%SuperController,1))) - b1 = (t(3)**2*(y1%SuperController - y2%SuperController) + t(2)**2*(-y1%SuperController + y3%SuperController))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%SuperController + t(3)*y2%SuperController - t(2)*y3%SuperController ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%SuperController = y1%SuperController + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%SuperController,1),UBOUND(y_out%SuperController,1) + b = (t(3)**2*(y1%SuperController(i1) - y2%SuperController(i1)) + t(2)**2*(-y1%SuperController(i1) + y3%SuperController(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%SuperController(i1) + t(3)*y2%SuperController(i1) - t(2)*y3%SuperController(i1) ) * scaleFactor + y_out%SuperController(i1) = y1%SuperController(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = (t(3)**2*(y1%WriteOutput - y2%WriteOutput) + t(2)**2*(-y1%WriteOutput + y3%WriteOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WriteOutput + t(3)*y2%WriteOutput - t(2)*y3%WriteOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO END IF ! check if allocated END SUBROUTINE OpFM_Output_ExtrapInterp2 diff --git a/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 b/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 index 8efb21566c..51a40873d8 100644 --- a/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 +++ b/modules/orcaflex-interface/src/OrcaFlexInterface_Types.f90 @@ -204,16 +204,16 @@ SUBROUTINE Orca_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMax - Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(InData%InputFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + ReKiBuf(Re_Xferred) = InData%TMax + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Orca_PackInitInput SUBROUTINE Orca_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -229,12 +229,6 @@ SUBROUTINE Orca_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -250,16 +244,16 @@ SUBROUTINE Orca_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%InputFile) - OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%TMax = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(OutData%InputFile) + OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%TMax = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Orca_UnPackInitInput SUBROUTINE Orca_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -452,12 +446,12 @@ SUBROUTINE Orca_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -469,12 +463,12 @@ SUBROUTINE Orca_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF END SUBROUTINE Orca_PackInitOutput @@ -491,12 +485,6 @@ SUBROUTINE Orca_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -564,19 +552,12 @@ SUBROUTINE Orca_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated Int_Xferred = Int_Xferred + 1 @@ -591,19 +572,12 @@ SUBROUTINE Orca_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF END SUBROUTINE Orca_UnPackInitOutput @@ -706,26 +680,26 @@ SUBROUTINE Orca_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%DLL_FileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_FileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%DLL_InitProcName) - IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_InitProcName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%DLL_CalcProcName) - IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_CalcProcName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%DLL_EndProcName) - IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_EndProcName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%DirRoot) - IntKiBuf(Int_Xferred) = ICHAR(InData%DirRoot(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(InData%DLL_FileName) + IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_FileName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%DLL_InitProcName) + IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_InitProcName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%DLL_CalcProcName) + IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_CalcProcName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%DLL_EndProcName) + IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_EndProcName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%DirRoot) + IntKiBuf(Int_Xferred) = ICHAR(InData%DirRoot(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE Orca_PackInputFile SUBROUTINE Orca_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -741,12 +715,6 @@ SUBROUTINE Orca_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Orca_UnPackInputFile' @@ -760,26 +728,26 @@ SUBROUTINE Orca_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%DLL_FileName) - OutData%DLL_FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%DLL_InitProcName) - OutData%DLL_InitProcName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%DLL_CalcProcName) - OutData%DLL_CalcProcName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%DLL_EndProcName) - OutData%DLL_EndProcName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%DirRoot) - OutData%DirRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%DLL_FileName) + OutData%DLL_FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%DLL_InitProcName) + OutData%DLL_InitProcName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%DLL_CalcProcName) + OutData%DLL_CalcProcName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%DLL_EndProcName) + OutData%DLL_EndProcName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%DirRoot) + OutData%DirRoot(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE Orca_UnPackInputFile SUBROUTINE Orca_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -873,8 +841,8 @@ SUBROUTINE Orca_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyOtherState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyOtherState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Orca_PackOtherState SUBROUTINE Orca_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -890,12 +858,6 @@ SUBROUTINE Orca_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Orca_UnPackOtherState' @@ -909,8 +871,8 @@ SUBROUTINE Orca_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyOtherState = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyOtherState = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Orca_UnPackOtherState SUBROUTINE Orca_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) @@ -1032,12 +994,20 @@ SUBROUTINE Orca_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PtfmAM))-1 ) = PACK(InData%PtfmAM,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PtfmAM) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PtfmFt))-1 ) = PACK(InData%PtfmFt,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PtfmFt) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F_PtfmAM))-1 ) = PACK(InData%F_PtfmAM,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F_PtfmAM) + DO i2 = LBOUND(InData%PtfmAM,2), UBOUND(InData%PtfmAM,2) + DO i1 = LBOUND(InData%PtfmAM,1), UBOUND(InData%PtfmAM,1) + ReKiBuf(Re_Xferred) = InData%PtfmAM(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + DO i1 = LBOUND(InData%PtfmFt,1), UBOUND(InData%PtfmFt,1) + ReKiBuf(Re_Xferred) = InData%PtfmFt(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%F_PtfmAM,1), UBOUND(InData%F_PtfmAM,1) + ReKiBuf(Re_Xferred) = InData%F_PtfmAM(i1) + Re_Xferred = Re_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%AllOuts) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1048,11 +1018,13 @@ SUBROUTINE Orca_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AllOuts,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AllOuts)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AllOuts))-1 ) = PACK(InData%AllOuts,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AllOuts) + DO i1 = LBOUND(InData%AllOuts,1), UBOUND(InData%AllOuts,1) + ReKiBuf(Re_Xferred) = InData%AllOuts(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%LastTimeStep - Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%LastTimeStep + Db_Xferred = Db_Xferred + 1 END SUBROUTINE Orca_PackMisc SUBROUTINE Orca_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1068,12 +1040,6 @@ SUBROUTINE Orca_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -1093,37 +1059,24 @@ SUBROUTINE Orca_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg i1_u = UBOUND(OutData%PtfmAM,1) i2_l = LBOUND(OutData%PtfmAM,2) i2_u = UBOUND(OutData%PtfmAM,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%PtfmAM = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PtfmAM))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PtfmAM) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PtfmAM,2), UBOUND(OutData%PtfmAM,2) + DO i1 = LBOUND(OutData%PtfmAM,1), UBOUND(OutData%PtfmAM,1) + OutData%PtfmAM(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO i1_l = LBOUND(OutData%PtfmFt,1) i1_u = UBOUND(OutData%PtfmFt,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%PtfmFt = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PtfmFt))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PtfmFt) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%PtfmFt,1), UBOUND(OutData%PtfmFt,1) + OutData%PtfmFt(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%F_PtfmAM,1) i1_u = UBOUND(OutData%F_PtfmAM,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%F_PtfmAM = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F_PtfmAM))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F_PtfmAM) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%F_PtfmAM,1), UBOUND(OutData%F_PtfmAM,1) + OutData%F_PtfmAM(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AllOuts not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1137,18 +1090,13 @@ SUBROUTINE Orca_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AllOuts.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%AllOuts)>0) OutData%AllOuts = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AllOuts))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AllOuts) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AllOuts,1), UBOUND(OutData%AllOuts,1) + OutData%AllOuts(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%LastTimeStep = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%LastTimeStep = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 END SUBROUTINE Orca_UnPackMisc SUBROUTINE Orca_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -1314,8 +1262,8 @@ SUBROUTINE Orca_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 CALL DLLTypePack( InData%DLL_Orca, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! DLL_Orca CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -1344,14 +1292,14 @@ SUBROUTINE Orca_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - DO I = 1, LEN(InData%SimNamePath) - IntKiBuf(Int_Xferred) = ICHAR(InData%SimNamePath(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%SimNamePathLen - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%SimNamePath) + IntKiBuf(Int_Xferred) = ICHAR(InData%SimNamePath(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%SimNamePathLen + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%OutParam) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1408,12 +1356,6 @@ SUBROUTINE Orca_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1428,8 +1370,8 @@ SUBROUTINE Orca_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -1470,14 +1412,14 @@ SUBROUTINE Orca_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - DO I = 1, LEN(OutData%SimNamePath) - OutData%SimNamePath(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%SimNamePathLen = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%SimNamePath) + OutData%SimNamePath(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%SimNamePathLen = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParam not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1690,12 +1632,6 @@ SUBROUTINE Orca_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Orca_UnPackInput' @@ -1921,8 +1857,10 @@ SUBROUTINE Orca_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WriteOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WriteOutput))-1 ) = PACK(InData%WriteOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WriteOutput) + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE Orca_PackOutput @@ -1939,12 +1877,6 @@ SUBROUTINE Orca_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -2012,15 +1944,10 @@ SUBROUTINE Orca_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WriteOutput)>0) OutData%WriteOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WriteOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WriteOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE Orca_UnPackOutput @@ -2115,8 +2042,8 @@ SUBROUTINE Orca_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Dummy - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Dummy + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Orca_PackContState SUBROUTINE Orca_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2132,12 +2059,6 @@ SUBROUTINE Orca_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Orca_UnPackContState' @@ -2151,8 +2072,8 @@ SUBROUTINE Orca_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%Dummy = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%Dummy = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Orca_UnPackContState SUBROUTINE Orca_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) @@ -2246,8 +2167,8 @@ SUBROUTINE Orca_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Dummy - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Dummy + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Orca_PackDiscState SUBROUTINE Orca_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2263,12 +2184,6 @@ SUBROUTINE Orca_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Orca_UnPackDiscState' @@ -2282,8 +2197,8 @@ SUBROUTINE Orca_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%Dummy = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%Dummy = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Orca_UnPackDiscState SUBROUTINE Orca_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) @@ -2377,8 +2292,8 @@ SUBROUTINE Orca_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyConstrState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Orca_PackConstrState SUBROUTINE Orca_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2394,12 +2309,6 @@ SUBROUTINE Orca_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'Orca_UnPackConstrState' @@ -2413,8 +2322,8 @@ SUBROUTINE Orca_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyConstrState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyConstrState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE Orca_UnPackConstrState @@ -2492,8 +2401,8 @@ SUBROUTINE Orca_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'Orca_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -2508,6 +2417,8 @@ SUBROUTINE Orca_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(u1%PtfmMesh, u2%PtfmMesh, tin, u_out%PtfmMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE Orca_Input_ExtrapInterp1 @@ -2539,8 +2450,9 @@ SUBROUTINE Orca_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'Orca_Input_ExtrapInterp2' @@ -2562,6 +2474,8 @@ SUBROUTINE Orca_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(u1%PtfmMesh, u2%PtfmMesh, u3%PtfmMesh, tin, u_out%PtfmMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE Orca_Input_ExtrapInterp2 @@ -2641,12 +2555,12 @@ SUBROUTINE Orca_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'Orca_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -2659,15 +2573,15 @@ SUBROUTINE Orca_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(y1%PtfmMesh, y2%PtfmMesh, tin, y_out%PtfmMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = -(y1%WriteOutput - y2%WriteOutput)/t(2) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO END IF ! check if allocated END SUBROUTINE Orca_Output_ExtrapInterp1 @@ -2698,13 +2612,14 @@ SUBROUTINE Orca_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'Orca_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -2723,16 +2638,16 @@ SUBROUTINE Orca_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(y1%PtfmMesh, y2%PtfmMesh, y3%PtfmMesh, tin, y_out%PtfmMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = (t(3)**2*(y1%WriteOutput - y2%WriteOutput) + t(2)**2*(-y1%WriteOutput + y3%WriteOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WriteOutput + t(3)*y2%WriteOutput - t(2)*y3%WriteOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO END IF ! check if allocated END SUBROUTINE Orca_Output_ExtrapInterp2 diff --git a/modules/servodyn/src/BladedInterface.f90 b/modules/servodyn/src/BladedInterface.f90 index 98b9e65bd1..8fd332cdec 100644 --- a/modules/servodyn/src/BladedInterface.f90 +++ b/modules/servodyn/src/BladedInterface.f90 @@ -29,22 +29,22 @@ MODULE BladedInterface IMPLICIT NONE - TYPE(ProgDesc), PARAMETER :: BladedInterface_Ver = ProgDesc( 'ServoDyn Interface for Bladed Controllers', 'using '//TRIM(OS_Desc), '14-Oct-2015' ) + TYPE(ProgDesc), PARAMETER :: BladedInterface_Ver = ProgDesc( 'ServoDyn Interface for Bladed Controllers', 'using '//TRIM(OS_Desc), '' ) !> Definition of the DLL Interface (from Bladed): !! Note that aviFAIL and avcMSG should be used as INTENT(OUT), but I'm defining them INTENT(INOUT) just in case the compiler decides to reinitialize something that's INTENT(OUT) ABSTRACT INTERFACE - SUBROUTINE BladedDLL_Procedure ( avrSWAP, aviFAIL, accINFILE, avcOUTNAME, avcMSG ) BIND(C) + SUBROUTINE BladedDLL_Legacy_Procedure ( avrSWAP, aviFAIL, accINFILE, avcOUTNAME, avcMSG ) BIND(C) USE, INTRINSIC :: ISO_C_Binding REAL(C_FLOAT), INTENT(INOUT) :: avrSWAP (*) !< DATA INTEGER(C_INT), INTENT(INOUT) :: aviFAIL !< FLAG (Status set in DLL and returned to simulation code) CHARACTER(KIND=C_CHAR), INTENT(IN) :: accINFILE (*) !< INFILE - CHARACTER(KIND=C_CHAR), INTENT(IN) :: avcOUTNAME(*) !< OUTNAME (Simulation RootName) + CHARACTER(KIND=C_CHAR), INTENT(INOUT) :: avcOUTNAME(*) !< OUTNAME (in:Simulation RootName; out:Name:Units; of logging channels) CHARACTER(KIND=C_CHAR), INTENT(INOUT) :: avcMSG (*) !< MESSAGE (Message from DLL to simulation code [ErrMsg]) - END SUBROUTINE BladedDLL_Procedure + END SUBROUTINE BladedDLL_Legacy_Procedure SUBROUTINE BladedDLL_SC_Procedure ( avrSWAP, from_SC, to_SC, aviFAIL, accINFILE, avcOUTNAME, avcMSG ) BIND(C) USE, INTRINSIC :: ISO_C_Binding @@ -54,13 +54,22 @@ SUBROUTINE BladedDLL_SC_Procedure ( avrSWAP, from_SC, to_SC, aviFAIL, accINFILE, REAL(C_FLOAT), INTENT(INOUT) :: to_SC (*) !< DATA to the supercontroller INTEGER(C_INT), INTENT(INOUT) :: aviFAIL !< FLAG (Status set in DLL and returned to simulation code) CHARACTER(KIND=C_CHAR), INTENT(IN) :: accINFILE (*) !< INFILE - CHARACTER(KIND=C_CHAR), INTENT(IN) :: avcOUTNAME(*) !< OUTNAME (Simulation RootName) + CHARACTER(KIND=C_CHAR), INTENT(INOUT) :: avcOUTNAME(*) !< OUTNAME (Simulation RootName) CHARACTER(KIND=C_CHAR), INTENT(INOUT) :: avcMSG (*) !< MESSAGE (Message from DLL to simulation code [ErrMsg]) END SUBROUTINE BladedDLL_SC_Procedure - - END INTERFACE + FUNCTION BladedDLL_CONTROLLER_Procedure ( turbine_id ) BIND (C) ! from Bladed 4.8 API + USE, INTRINSIC :: ISO_C_Binding + +! INTEGER(C_SIZE_T), VALUE, INTENT(IN ) :: turbine_id ! pointer (address) of data from Bladed or ENFAST that is required to be used in ExternalControllerApi.dll (as written in Bladed's API) + TYPE(C_PTR), VALUE, INTENT(IN ) :: turbine_id ! pointer (address) of data from Bladed or ENFAST that is required to be used in ExternalControllerApi.dll (using standard Fortran nomenclature for ISO C BINDING) + INTEGER(C_INT) :: BladedDLL_CONTROLLER_Procedure ! an integer determining the status of the call (see aviFAIL) + + END FUNCTION BladedDLL_CONTROLLER_Procedure + + END INTERFACE + #ifdef STATIC_DLL_LOAD INTERFACE @@ -89,39 +98,120 @@ END SUBROUTINE DISCON ! Some constants for the Interface: INTEGER(IntKi), PARAMETER :: R_v36 = 85 !< Start of below-rated torque-speed look-up table (record no.) for Bladed version 3.6 - INTEGER(IntKi), PARAMETER :: R_v4 = 145 !< Start of below-rated torque-speed look-up table (record no.) for Bladed version 3.8 and later + INTEGER(IntKi), PARAMETER :: R_v4 = 145 !< Start of below-rated torque-speed look-up table (record no.) for Bladed version 3.8 - 4.2 + INTEGER(IntKi), PARAMETER :: R_v43 = 165 !< Start of below-rated torque-speed look-up table (record no.) for Bladed version 4.3 and later - INTEGER(IntKi), PARAMETER :: R = R_v4 !< start of the generator speed look-up table - + INTEGER(IntKi), PARAMETER :: R = R_v43 !< start of the generator speed look-up table +#ifdef STATIC_DLL_LOAD + INTEGER(IntKi), PARAMETER :: MaxLoggingChannels = 0 +#else + INTEGER(IntKi), PARAMETER :: MaxLoggingChannels = 300 +#endif + + !! GH_DISCON_SIMULATION_STATUS - Flag returned by simulation from GetSimulationStatus. Descriptions taken from the user manual. + INTEGER(IntKi), PARAMETER :: GH_DISCON_STATUS_FINALISING = -1 ! Final call at the end of the simulation. + INTEGER(IntKi), PARAMETER :: GH_DISCON_STATUS_INITIALISING = 0 ! First call at time zero. + INTEGER(IntKi), PARAMETER :: GH_DISCON_STATUS_DISCRETE_STEP = 1 ! Simulation discrete timestep. + INTEGER(IntKi), PARAMETER :: GH_DISCON_STATUS_CHECKPOINT = -8 ! Create a checkpoint file (extension to GH DISCON documentation) + INTEGER(IntKi), PARAMETER :: GH_DISCON_STATUS_RESTARTING = -9 ! Restart step (extension to GH DISCON documentation) + !! GH_DISCON_PITCH_CONTROL - Flag to specify whether the pitch is controlled collectively or individually. + INTEGER(IntKi), PARAMETER :: GH_DISCON_PITCH_CONTROL_COLLECTIVE = 0 ! Pitch is controlled collectively - use GetCollectivePitchAngle and SetDemandedCollectivePitchAngle. + INTEGER(IntKi), PARAMETER :: GH_DISCON_PITCH_CONTROL_INDIVIDUAL = 1 ! Pitch is controlled on each blade individually - use GetPitchAngle and SetDemandedPitchAngle. + !! GH_DISCON_YAW_CONTROL - Flag to represent whether the yaw is controlled by rate or torque. + INTEGER(IntKi), PARAMETER :: GH_DISCON_YAW_CONTROL_RATE = 0 ! Uses the yaw rate demand to control yaw. + INTEGER(IntKi), PARAMETER :: GH_DISCON_YAW_CONTROL_TORQUE = 1 ! Uses the yaw torque demand to control yaw. CONTAINS !================================================================================================================================== !> This SUBROUTINE is used to call the Bladed-style DLL. -SUBROUTINE CallBladedDLL ( u, DLL, dll_data, p, ErrStat, ErrMsg ) +SUBROUTINE CallBladedDLL ( u, p, dll_data, ErrStat, ErrMsg, ChannelNameUnit ) + + TYPE(SrvD_InputType), INTENT(IN ) :: u ! System inputs + TYPE(SrvD_ParameterType), INTENT(IN ) :: p ! Parameters + TYPE(BladedDLLType), TARGET, INTENT(INOUT) :: dll_data ! data type containing the inputs for the Bladed DLL interface + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + CHARACTER(*), OPTIONAL, INTENT( OUT) :: ChannelNameUnit ! OUTNAME (Simulation RootName) + + PROCEDURE(BladedDLL_CONTROLLER_Procedure), POINTER :: DLL_CONTROLLER ! The address of the CONTROLLER or CONTROLLER_INIT procedure in the Bladed DLL + INTEGER :: ProcedureIndex + INTEGER(C_INT) :: aviFAIL ! status returned from Bladed controller + TYPE(C_PTR) :: turbine_id + TYPE(BladedDLLType), POINTER :: dll_data_PTR ! pointer to data type containing the inputs for the Bladed DLL interface + + + if (p%UseLegacyInterface) then + if (present(ChannelNameUnit)) then + call CallBladedLegacyDLL ( u, p, dll_data, ErrStat, ErrMsg, ChannelNameUnit ) + else + call CallBladedLegacyDLL ( u, p, dll_data, ErrStat, ErrMsg ) + end if + else + + if ( dll_data%SimStatus == GH_DISCON_STATUS_INITIALISING ) then + ProcedureIndex = 2 ! initialization call to CONTROLLER or CONTROLLER_INIT + else + ProcedureIndex = 1 ! normal call to CONTROLLER + end if + + CALL C_F_PROCPOINTER( p%DLL_Trgt%ProcAddr(ProcedureIndex), DLL_CONTROLLER) + dll_data_PTR => dll_data + turbine_id = C_LOC(dll_data_PTR) + + aviFAIL = DLL_CONTROLLER ( turbine_id ) + + ! these values are set in the controller: + ErrStat = dll_data%ErrStat + ErrMsg = dll_data%ErrMsg + + ! but we must also check the return value from the controller function (i'd think they would be the same) + IF ( aviFAIL /= 0 ) THEN + + IF ( aviFAIL > 0 ) THEN ! warning + ErrStat = max(ErrStat,ErrID_Info) + ELSE ! error + ErrStat = ErrID_Fatal + END IF + + END IF + + IF (ErrStat /= ErrID_None) THEN + ErrMsg = trim(p%DLL_Trgt%ProcName(ProcedureIndex))//trim(ErrMsg) + END IF + + end if - ! Passed Variables: + if ( dll_data%SimStatus == GH_DISCON_STATUS_FINALISING ) then + dll_data%SimStatus = GH_DISCON_STATUS_INITIALISING + else + dll_data%SimStatus = GH_DISCON_STATUS_DISCRETE_STEP + end if + +END SUBROUTINE CallBladedDLL +!================================================================================================================================== +SUBROUTINE CallBladedLegacyDLL ( u, p, dll_data, ErrStat, ErrMsg, ChannelNameUnit ) + ! Passed Variables: TYPE(SrvD_InputType), INTENT(IN ) :: u ! System inputs - TYPE(DLL_Type), INTENT(IN ) :: DLL ! The DLL to be called. - TYPE(BladedDLLType), INTENT(INOUT) :: dll_data ! data type containing the avrSWAP, accINFILE, and avcOUTNAME arrays TYPE(SrvD_ParameterType), INTENT(IN ) :: p ! Parameters + TYPE(BladedDLLType), INTENT(INOUT) :: dll_data ! data type containing the avrSWAP, accINFILE, and avcOUTNAME arrays !REAL(SiKi), INTENT(INOUT) :: avrSWAP (*) ! The swap array, used to pass data to, and receive data from, the DLL controller. !INTEGER(B1Ki), INTENT(IN ) :: accINFILE (*) ! The address of the first record of an array of 1-byte CHARACTERs giving the name of the parameter input file, 'DISCON.IN'. - !INTEGER(B1Ki), INTENT(IN ) :: avcOUTNAME(*) ! The address of the first record of an array of 1-byte CHARACTERS giving the simulation run name without extension. + !INTEGER(B1Ki), INTENT(INOUT) :: avcOUTNAME(*) ! The address of the first record of an array of 1-byte CHARACTERS giving the simulation run name without extension. - INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation - CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None - + INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None + CHARACTER(*), OPTIONAL, INTENT( OUT) :: ChannelNameUnit ! OUTNAME (Simulation RootName) + ! Local Variables: INTEGER(C_INT) :: aviFAIL ! A flag used to indicate the success of this DLL call set as follows: 0 if the DLL call was successful, >0 if the DLL call was successful but cMessage should be issued as a warning messsage, <0 if the DLL call was unsuccessful or for any other reason the simulation is to be stopped at this point with cMessage as the error message. - CHARACTER(KIND=C_CHAR) :: accINFILE(LEN_TRIM(p%DLL_InFile)+1) ! INFILE - CHARACTER(KIND=C_CHAR) :: avcOUTNAME(LEN_TRIM(p%RootName)+1) ! OUTNAME (Simulation RootName) - CHARACTER(KIND=C_CHAR) :: avcMSG(LEN(ErrMsg)+1) ! MESSAGE (Message from DLL to simulation code [ErrMsg]) - + CHARACTER(KIND=C_CHAR) :: accINFILE(LEN_TRIM(dll_data%DLL_InFile)+1) ! INFILE + CHARACTER(KIND=C_CHAR) :: avcOUTNAME(p%avcOUTNAME_LEN) ! OUTNAME (in: Simulation RootName; out: string for logging channels Name:Units;) + CHARACTER(KIND=C_CHAR) :: avcMSG(LEN(ErrMsg)+1) ! MESSAGE (Message from DLL to simulation code [ErrMsg]) - PROCEDURE(BladedDLL_Procedure), POINTER :: DLL_Subroutine ! The address of the procedure in the Bladed DLL - PROCEDURE(BladedDLL_SC_Procedure),POINTER :: DLL_SC_Subroutine ! The address of the supercontroller procedure in the Bladed DLL + PROCEDURE(BladedDLL_Legacy_Procedure), POINTER :: DLL_Legacy_Subroutine ! The address of the (legacy DISCON) procedure in the Bladed DLL + PROCEDURE(BladedDLL_SC_Procedure), POINTER :: DLL_SC_Subroutine ! The address of the supercontroller procedure in the Bladed DLL ! initialize aviFAIL @@ -129,9 +219,9 @@ SUBROUTINE CallBladedDLL ( u, DLL, dll_data, p, ErrStat, ErrMsg ) !Convert to C-type characters: the "C_NULL_CHAR" converts the Fortran string to a C-type string (i.e., adds //CHAR(0) to the end) - avcOUTNAME = TRANSFER( TRIM(p%RootName)//C_NULL_CHAR, avcOUTNAME ) - accINFILE = TRANSFER( TRIM(p%DLL_InFile)//C_NULL_CHAR, accINFILE ) - avcMSG = TRANSFER( C_NULL_CHAR, avcMSG ) !bjj this is intent(out), so we shouldn't have to do this, but, to be safe... + avcOUTNAME = TRANSFER( TRIM(dll_data%RootName)//C_NULL_CHAR, avcOUTNAME ) + accINFILE = TRANSFER( TRIM(dll_data%DLL_InFile)//C_NULL_CHAR, accINFILE ) + avcMSG = TRANSFER( C_NULL_CHAR, avcMSG ) !bjj this is intent(out), so we shouldn't have to do this, but, to be safe... #ifdef STATIC_DLL_LOAD @@ -147,15 +237,13 @@ SUBROUTINE CallBladedDLL ( u, DLL, dll_data, p, ErrStat, ErrMsg ) IF ( ALLOCATED(dll_data%SCoutput) ) THEN ! Call the DLL (first associate the address from the procedure in the DLL with the subroutine): - CALL C_F_PROCPOINTER( DLL%ProcAddr(1), DLL_SC_Subroutine) + CALL C_F_PROCPOINTER( p%DLL_Trgt%ProcAddr(1), DLL_SC_Subroutine) CALL DLL_SC_Subroutine ( dll_data%avrSWAP, u%SuperController, dll_data%SCoutput, aviFAIL, accINFILE, avcOUTNAME, avcMSG ) ELSE - ! Call the DLL (first associate the address from the procedure in the DLL with the subroutine): - CALL C_F_PROCPOINTER( DLL%ProcAddr(1), DLL_Subroutine) - CALL DLL_Subroutine ( dll_data%avrSWAP, aviFAIL, accINFILE, avcOUTNAME, avcMSG ) - + CALL C_F_PROCPOINTER( p%DLL_Trgt%ProcAddr(1), DLL_Legacy_Subroutine) + CALL DLL_Legacy_Subroutine ( dll_data%avrSWAP, aviFAIL, accINFILE, avcOUTNAME, avcMSG ) END IF #endif @@ -175,12 +263,17 @@ SUBROUTINE CallBladedDLL ( u, DLL, dll_data, p, ErrStat, ErrMsg ) ErrStat = ErrID_None ErrMsg = '' END IF + + IF (PRESENT(ChannelNameUnit)) THEN + ChannelNameUnit = TRANSFER(avcOUTNAME,ChannelNameUnit) !convert C character array to Fortran string + CALL RemoveNullChar( ChannelNameUnit ) + END IF RETURN -END SUBROUTINE CallBladedDLL +END SUBROUTINE CallBladedLegacyDLL !================================================================================================================================== !> This routine initializes variables used in the Bladed DLL interface. -SUBROUTINE BladedInterface_Init(u,p,m,y,InputFileData, ErrStat, ErrMsg) +SUBROUTINE BladedInterface_Init(u, p, m, y, InputFileData, InitInp, ErrStat, ErrMsg) TYPE(SrvD_InputType), INTENT(INOUT) :: u !< An initial guess for the input; input mesh must be defined TYPE(SrvD_ParameterType), INTENT(INOUT) :: p !< Parameters @@ -188,12 +281,13 @@ SUBROUTINE BladedInterface_Init(u,p,m,y,InputFileData, ErrStat, ErrMsg) TYPE(SrvD_OutputType), INTENT(INOUT) :: y !< Initial system outputs (outputs are not calculated; !! only the output mesh is initialized) TYPE(SrvD_InputFile), INTENT(INOUT) :: InputFileData !< Data stored in the module's input file + TYPE(SrvD_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None ! local variables - + INTEGER(IntKi) :: i ! loop counter INTEGER(IntKi) :: ErrStat2 ! The error status code CHARACTER(ErrMsgLen) :: ErrMsg2 ! The error message, if an error occurred @@ -210,61 +304,71 @@ SUBROUTINE BladedInterface_Init(u,p,m,y,InputFileData, ErrStat, ErrMsg) CALL DispNVD( BladedInterface_Ver ) ! Display the version of this interface - p%Ptch_Cntrl = InputFileData%Ptch_Cntrl - p%Gain_OM = InputFileData%Gain_OM ! Optimal mode gain (Nm/(rad/s)^2) - p%GenPwr_Dem = InputFileData%GenPwr_Dem ! Demanded power (W) - p%GenSpd_Dem = InputFileData%GenSpd_Dem ! Demanded generator speed above rated (rad/s) - p%GenSpd_MaxOM = InputFileData%GenSpd_MaxOM ! Optimal mode maximum speed (rad/s) - p%GenSpd_MinOM = InputFileData%GenSpd_MinOM ! Minimum generator speed (rad/s) - p%GenTrq_Dem = InputFileData%GenTrq_Dem ! Demanded generator torque (Nm) - p%Ptch_Max = InputFileData%Ptch_Max ! Maximum pitch angle (rad) - p%Ptch_Min = InputFileData%Ptch_Min ! Minimum pitch angle (rad) - p%Ptch_SetPnt = InputFileData%Ptch_SetPnt ! Below-rated pitch angle set-point (rad) - p%PtchRate_Max = InputFileData%PtchRate_Max ! Maximum pitch rate (rad/s) - p%PtchRate_Min = InputFileData%PtchRate_Min ! Minimum pitch rate (most negative value allowed) (rad/s) - p%NacYaw_North = InputFileData%NacYaw_North ! Reference yaw angle of the nacelle when the upwind end points due North (rad) - - p%DLL_NumTrq = InputFileData%DLL_NumTrq ! No. of points in torque-speed look-up table: 0 = none and use the optimal mode PARAMETERs instead, nonzero = ignore the optimal mode PARAMETERs by setting Record 16 to 0.0 (-) - p%DLL_InFile = InputFileData%DLL_InFile - - p%DLL_DT = InputFileData%DLL_DT - IF ( .NOT. EqualRealNos( NINT( p%DLL_DT / p%DT ) * p%DT, p%DLL_DT ) ) THEN + p%UseLegacyInterface = InputFileData%UseLegacyInterface + + m%dll_data%Ptch_Cntrl = InputFileData%Ptch_Cntrl + m%dll_data%Gain_OM = InputFileData%Gain_OM ! Optimal mode gain (Nm/(rad/s)^2) + m%dll_data%GenPwr_Dem = InputFileData%GenPwr_Dem ! Demanded power (W) + m%dll_data%GenSpd_Dem = InputFileData%GenSpd_Dem ! Demanded generator speed above rated (rad/s) + m%dll_data%GenSpd_MaxOM = InputFileData%GenSpd_MaxOM ! Optimal mode maximum speed (rad/s) + m%dll_data%GenSpd_MinOM = InputFileData%GenSpd_MinOM ! Minimum generator speed (rad/s) + m%dll_data%GenTrq_Dem = InputFileData%GenTrq_Dem ! Demanded generator torque above rated (Nm) + m%dll_data%Ptch_Max = InputFileData%Ptch_Max ! Maximum pitch angle (rad) + m%dll_data%Ptch_Min = InputFileData%Ptch_Min ! Minimum pitch angle (rad) + m%dll_data%Ptch_SetPnt = InputFileData%Ptch_SetPnt ! Below-rated pitch angle set-point (rad) + m%dll_data%PtchRate_Max = InputFileData%PtchRate_Max ! Maximum pitch rate (rad/s) + m%dll_data%PtchRate_Min = InputFileData%PtchRate_Min ! Minimum pitch rate (most negative value allowed) (rad/s) + p%NacYaw_North = InputFileData%NacYaw_North ! Reference yaw angle of the nacelle when the upwind end points due North (rad) + + m%dll_data%DLL_NumTrq = InputFileData%DLL_NumTrq ! No. of points in torque-speed look-up table: 0 = none and use the optimal mode PARAMETERs instead, nonzero = ignore the optimal mode PARAMETERs by setting Record 16 to 0.0 (-) + + m%dll_data%DLL_InFile = InputFileData%DLL_InFile + m%dll_data%RootName = p%RootName + p%avcOUTNAME_LEN = max( LEN_TRIM(m%dll_data%RootName), MaxLoggingChannels*2*(1+ChanLen) ) + 1 ! = max( size of input, size of output ) + c_null_char + + m%dll_data%DLL_DT = InputFileData%DLL_DT ! Communication interval (sec) + p%DLL_n = NINT( m%dll_data%DLL_DT / p%DT ) + IF ( .NOT. EqualRealNos( p%DLL_n * p%DT, m%dll_data%DLL_DT ) ) THEN CALL CheckError( ErrID_Fatal, 'DLL_DT must be an integer multiple of DT.' ) END IF - IF ( p%DLL_DT < EPSILON( p%DLL_DT ) ) THEN + IF ( m%dll_data%DLL_DT < EPSILON( m%dll_data%DLL_DT ) ) THEN CALL CheckError( ErrID_Fatal, 'DLL_DT must be larger than zero.' ) END IF - + p%DLL_Ramp = InputFileData%DLL_Ramp - p%BlAlpha = exp( -TwoPi*p%DT*InputFileData%BPCutoff ) !used only for the DLL - m%dll_data%PrevBlPitch(1:p%NumBl) = p%BlPitchInit + p%BlAlpha = exp( -TwoPi*p%DT*InputFileData%BPCutoff ) !used only for the DLL if (InputFileData%BPCutoff < EPSILON( InputFileData%BPCutoff )) CALL CheckError( ErrID_Fatal, 'BPCutoff must be greater than 0.') - IF ( p%Ptch_Cntrl /= 1_IntKi .AND. p%Ptch_Cntrl /= 0_IntKi ) THEN - CALL CheckError( ErrID_Fatal, 'Ptch_Cntrl must be 0 or 1.') + IF ( m%dll_data%Ptch_Cntrl /= GH_DISCON_PITCH_CONTROL_INDIVIDUAL .AND. m%dll_data%Ptch_Cntrl /= GH_DISCON_PITCH_CONTROL_COLLECTIVE ) THEN + CALL CheckError( ErrID_Fatal, 'Ptch_Cntrl must be 0 (collective) or 1 (individual).') + RETURN END IF + m%dll_data%Yaw_Cntrl = GH_DISCON_YAW_CONTROL_RATE ! currently only available option + m%dll_data%OverrideYawRateWithTorque = .false. + + CALL AllocAry( m%dll_data%BlPitchInput, p%NumBl, 'm%dll_data%BlPitchInput', ErrStat2, ErrMsg2 ) + CALL CheckError(ErrStat2,ErrMsg2) - IF ( p%DLL_NumTrq < 0_IntKi ) THEN + IF ( m%dll_data%DLL_NumTrq < 0_IntKi ) THEN CALL CheckError( ErrID_Fatal, 'DLL_NumTrq must not be less than zero.') - ELSEIF ( p%DLL_NumTrq > 0 ) THEN - CALL AllocAry( p%GenSpd_TLU, p%DLL_NumTrq, 'GenSpd_TLU', ErrStat2, ErrMsg2 ) - CALL CheckError(ErrStat2,ErrMsg2) - - CALL AllocAry( p%GenTrq_TLU, p%DLL_NumTrq, 'GenTrq_TLU',ErrStat2, ErrMsg2 ) - CALL CheckError(ErrStat2,ErrMsg2) - - - p%GenSpd_TLU = InputFileData%GenSpd_TLU ! Table (array) containing DLL_NumTrq generator speeds for the torque-speed table look-up (TLU) (rad/s) - p%GenTrq_TLU = InputFileData%GenTrq_TLU ! Table (array) containing DLL_NumTrq generator torques for the torque-speed table look-up (TLU) (Nm ) - - END IF + ELSEIF ( m%dll_data%DLL_NumTrq > 0 ) THEN + m%dll_data%Gain_OM = 0.0 ! 0.0 indicates that torque-speed table look-up is selected + + CALL MOVE_ALLOC(InputFileData%GenSpd_TLU, m%dll_data%GenSpd_TLU) ! Table (array) containing DLL_NumTrq generator speeds for the torque-speed table look-up (TLU) (rad/s) + CALL MOVE_ALLOC(InputFileData%GenTrq_TLU, m%dll_data%GenTrq_TLU) ! Table (array) containing DLL_NumTrq generator torques for the torque-speed table look-up (TLU) (Nm ) + END IF + IF ( ErrStat >= AbortErrLev ) RETURN - CALL AllocAry( m%dll_data%avrSwap, R+(2*p%DLL_NumTrq)-1, 'avrSwap', ErrStat2, ErrMsg2 ) + ! Set status flag and initialize avrSWAP: + m%dll_data%SimStatus = GH_DISCON_STATUS_INITIALISING + + CALL AllocAry( m%dll_data%avrSwap, R+(2*m%dll_data%DLL_NumTrq)-1 + MaxLoggingChannels, 'avrSwap', ErrStat2, ErrMsg2 ) CALL CheckError(ErrStat2,ErrMsg2) IF ( ErrStat >= AbortErrLev ) RETURN + m%dll_data%avrSWAP = 0.0 IF (ALLOCATED(y%SuperController)) THEN CALL AllocAry( m%dll_data%SCoutput, SIZE(y%SuperController), 'm%dll_data%SuperController', ErrStat2, ErrMsg2 ) @@ -275,12 +379,10 @@ SUBROUTINE BladedInterface_Init(u,p,m,y,InputFileData, ErrStat, ErrMsg) ! Initialize dll data stored in OtherState - m%dll_data%GenState = 1 - m%dll_data%GenTrq = 0.0 - m%dll_data%YawRateCom = 0.0 - m%dll_data%HSSBrFrac = 0.0 + m%dll_data%initialized = .FALSE. + + - #ifdef STATIC_DLL_LOAD ! because OpenFOAM needs the MPI task to copy the library, we're not going to dynamically load it; it needs to be loaded at runtime. p%DLL_Trgt%FileName = '' @@ -290,25 +392,57 @@ SUBROUTINE BladedInterface_Init(u,p,m,y,InputFileData, ErrStat, ErrMsg) p%DLL_Trgt%FileName = InputFileData%DLL_FileName - p%DLL_Trgt%ProcName = "" ! initialize all procedures to empty so we try to load only one - p%DLL_Trgt%ProcName(1) = InputFileData%DLL_ProcName + if (.not. p%UseLegacyInterface) then + p%DLL_Trgt%ProcName = "" ! initialize all procedures to empty so we try to load only two + p%DLL_Trgt%ProcName(1) = "CONTROLLER" + p%DLL_Trgt%ProcName(2) = "CONTROLLER_INIT" + + CALL LoadDynamicLib ( p%DLL_Trgt, ErrStat2, ErrMsg2 ) + if (ErrStat2 > ErrID_Fatal) then ! it loaded the DLL but didn't find the INIT routine + p%DLL_Trgt%ProcName(2) = p%DLL_Trgt%ProcName(1) ! we won't call the separate controller_init routine the first time + p%DLL_Trgt%ProcAddr(2) = p%DLL_Trgt%ProcAddr(1) + elseif (ErrStat2 == ErrID_Fatal) then + CALL CheckError(ErrID_Info,'Error opening BLADED interface DLL. Checking for legacy DLL.') + CALL FreeDynamicLib( p%DLL_Trgt, ErrStat2, ErrMsg2 ) ! this doesn't do anything #ifdef STATIC_DLL_LOAD because p%DLL_Trgt is 0 (NULL) + p%UseLegacyInterface = .true. ! Bladed checks for the legacy version if it can't find the CONTROLL function in the DLL, so that's what we'll have to do, too + end if + end if + + if (p%UseLegacyInterface) then + p%DLL_Trgt%ProcName = "" ! initialize all procedures to empty so we try to load only one + p%DLL_Trgt%ProcName(1) = InputFileData%DLL_ProcName + + CALL LoadDynamicLib ( p%DLL_Trgt, ErrStat2, ErrMsg2 ) + CALL CheckError(ErrStat2,ErrMsg2) + IF ( ErrStat >= AbortErrLev ) RETURN + CALL WrScr('Using legacy Bladed DLL interface.') + end if + +!-------------------------------------- + p%NumOuts_DLL = 0 +#ifdef LOAD_DLL_TWICE_FOR_LOGGING_CHANNELS + CALL GetBladedLoggingChannels(u,p,m, ErrStat2, ErrMsg2) ! this calls the DLL, but we don't have the correct inputs for a time step, so we'll close the DLL and start it again + CALL CheckError(ErrStat2,ErrMsg2) + IF ( ErrStat >= AbortErrLev ) RETURN + + ! close and reload library here... + ! (if the DLL could be guaranteed to not do anything with the + ! inputs on the initial step, we could avoid this this part) + + CALL BladedInterface_End(u, p, m, ErrStat2, ErrMsg2) + CALL CheckError(ErrStat2,ErrMsg2) + IF ( ErrStat >= AbortErrLev ) RETURN + CALL LoadDynamicLib ( p%DLL_Trgt, ErrStat2, ErrMsg2 ) CALL CheckError(ErrStat2,ErrMsg2) IF ( ErrStat >= AbortErrLev ) RETURN #endif - - ! Set status flag: - !m%dll_data%avrSWAP( 1) = 0.0 - m%dll_data%avrSWAP = 0.0 - !CALL Fill_avrSWAP( 0_IntKi, t, u, p, LEN(ErrMsg), m%dll_data ) ! Status flag set as follows: 0 if this is the first call, 1 for all subsequent time steps, -1 if this is the final call at the end of the simulation (-) - - - !CALL CallBladedDLL(p%DLL_Trgt, m%dll_data, ErrStat2, ErrMsg2) - ! CALL CheckError(ErrStat2,ErrMsg2) - ! IF ( ErrStat >= AbortErrLev ) RETURN - ! +!-------------------------------------- +#endif + + CONTAINS !............................................................................................................................... SUBROUTINE CheckError(ErrID,Msg) @@ -343,6 +477,172 @@ SUBROUTINE CheckError(ErrID,Msg) END SUBROUTINE CheckError END SUBROUTINE BladedInterface_Init !================================================================================================================================== +SUBROUTINE GetBladedLoggingChannels(u,p,m, ErrStat, ErrMsg) + + TYPE(SrvD_InputType), INTENT(IN ) :: u !< An initial guess for the input; input mesh must be defined + TYPE(SrvD_ParameterType), INTENT(INOUT) :: p !< Parameters + TYPE(SrvD_MiscVarType), INTENT(INOUT) :: m !< Initial misc (optimization) variables + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + + ! local variables + + INTEGER(IntKi) :: StartIndx ! starting index used to parse name/unit from Bladed DLL + INTEGER(IntKi) :: Indx ! index used to parse name/unit from Bladed DLL + INTEGER(IntKi) :: i ! The error status code + INTEGER(IntKi) :: ErrStat2 ! The error status code + CHARACTER( p%avcOUTNAME_LEN ) :: LoggingChannelStr ! The error message, if an error occurred + CHARACTER(*), PARAMETER :: RoutineName = "GetBladedLoggingChannels" + + + CALL Fill_CONTROL_vars( 0.0_DbKi, u, p, LEN(ErrMsg), m%dll_data ) + + if (p%UseLegacyInterface) then + + CALL CallBladedDLL(u, p, m%dll_data, ErrStat, ErrMsg, LoggingChannelStr) + IF ( ErrStat >= AbortErrLev ) RETURN + + p%NumOuts_DLL = NINT( m%dll_data%avrSWAP(65) ) ! number of channels returned for logging + + ALLOCATE ( m%dll_data%LogChannels_OutParam(p%NumOuts_DLL) , STAT=ErrStat2 ) + IF ( ErrStat2 /= 0_IntKi ) THEN + CALL SetErrStat( ErrID_Fatal,"Error allocating memory for the Bladed DLL logging channels name array.", ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + + ALLOCATE( m%dll_data%LogChannels(p%NumOuts_DLL), STAT=ErrStat2 ) + IF ( ErrStat2 /= 0_IntKi ) THEN + CALL SetErrStat( ErrID_Fatal,"Error allocating memory for the Bladed DLL logging channels array.", ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + + ! get names and units of channels + do i=1,p%NumOuts_DLL + m%dll_data%LogChannels_OutParam(i)%Indx = 0 + m%dll_data%LogChannels_OutParam(i)%SignM = 1 + m%dll_data%LogChannels_OutParam(i)%Name = "LogChan"//trim(num2lstr(i)) + m%dll_data%LogChannels_OutParam(i)%Units = "Unknown" + end do + + StartIndx = 1 + do i=1,p%NumOuts_DLL + + ! parse the channel name + indx = StartIndx + INDEX( LoggingChannelStr(StartIndx:), ':' ) - 1 + if (indx > len(LoggingChannelStr) .or. indx < 1) then + call SetErrStat( ErrID_Severe,"Error getting logging channel name.", ErrStat, ErrMsg, RoutineName ) + endif + + m%dll_data%LogChannels_OutParam(I)%Name = LoggingChannelStr(StartIndx:indx-1) + StartIndx = indx + 1 + + ! parse the channel units + indx = StartIndx + INDEX( LoggingChannelStr(StartIndx:), ';' ) - 1 + if (indx > len(LoggingChannelStr) .or. indx < 1) then + call SetErrStat( ErrID_Severe,"Error getting logging channel units.", ErrStat, ErrMsg, RoutineName ) + endif + + m%dll_data%LogChannels_OutParam(I)%Units = LoggingChannelStr(StartIndx:indx-1) + StartIndx = indx + 1 + end do + + !todo: make sure trim(m%dll_data%LogChannels_OutParam(i)%Name) does not contain spaces; replace with '_' if necessary + + else + + + ALLOCATE( m%dll_data%LogChannels( MaxLoggingChannels), & + m%dll_data%LogChannels_OutParam(MaxLoggingChannels), STAT=ErrStat2 ) + IF ( ErrStat2 /= 0_IntKi ) THEN + CALL SetErrStat( ErrID_Fatal,"Error allocating memory for the Bladed DLL logging channels.", ErrStat, ErrMsg, RoutineName ) + RETURN + ENDIF + + CALL CallBladedDLL(u, p, m%dll_data, ErrStat, ErrMsg) + IF ( ErrStat >= AbortErrLev ) RETURN + + p%NumOuts_DLL = m%dll_data%NumLogChannels ! set this as a parameter in case the DLL changes the value during the simulation + + end if + + + ! convert Bladed-allowed unit specifiers to actual units + do i=1,p%NumOuts_DLL + select case (m%dll_data%LogChannels_OutParam(I)%Units) + case('1/T') + m%dll_data%LogChannels_OutParam(I)%Units = 'Hz' + case('A') + m%dll_data%LogChannels_OutParam(I)%Units = 'rad' + case('A/P') + m%dll_data%LogChannels_OutParam(I)%Units = 'rad/W' + case('A/PT') + m%dll_data%LogChannels_OutParam(I)%Units = 'rad/Ws' + case('A/PTT') + m%dll_data%LogChannels_OutParam(I)%Units = 'rad/Ws^2' + case('A/T') + m%dll_data%LogChannels_OutParam(I)%Units = 'rad/s' + case('A/TT') + m%dll_data%LogChannels_OutParam(I)%Units = 'rad/s^2' + case('F') + m%dll_data%LogChannels_OutParam(I)%Units = 'N' + case('F/L') + m%dll_data%LogChannels_OutParam(I)%Units = 'N/m' + case('F/LL') + m%dll_data%LogChannels_OutParam(I)%Units = 'N/m^2' + case('FL') + m%dll_data%LogChannels_OutParam(I)%Units = 'Nm' + case('FL/A') + m%dll_data%LogChannels_OutParam(I)%Units = 'Nm/rad' + case('FL/L') + m%dll_data%LogChannels_OutParam(I)%Units = 'Nm/m' + case('FLL') + m%dll_data%LogChannels_OutParam(I)%Units = 'Nm^2' + case('FLT/A') + m%dll_data%LogChannels_OutParam(I)%Units = 'Nms/rad' + case('FLTT/AA') + m%dll_data%LogChannels_OutParam(I)%Units = 'Nms^2/rad^2' + case('I') + m%dll_data%LogChannels_OutParam(I)%Units = 'A' + case('L') + m%dll_data%LogChannels_OutParam(I)%Units = 'm' + case('L/T') + m%dll_data%LogChannels_OutParam(I)%Units = 'm/s' + case('L/TT') + m%dll_data%LogChannels_OutParam(I)%Units = 'm/s^2' + case('LLL') + m%dll_data%LogChannels_OutParam(I)%Units = 'm^3' + case('LLL/A') + m%dll_data%LogChannels_OutParam(I)%Units = 'm^3/rad' + case('M') + m%dll_data%LogChannels_OutParam(I)%Units = 'kg' + case('M/L') + m%dll_data%LogChannels_OutParam(I)%Units = 'kg/m' + case('M/LLL') + m%dll_data%LogChannels_OutParam(I)%Units = 'kg/m^3' + case('M/LT') + m%dll_data%LogChannels_OutParam(I)%Units = 'kg/ms' + case('MLL') + m%dll_data%LogChannels_OutParam(I)%Units = 'kgm^2' + case('N') + m%dll_data%LogChannels_OutParam(I)%Units = '-' + case('P') + m%dll_data%LogChannels_OutParam(I)%Units = 'W' + case('PT') + m%dll_data%LogChannels_OutParam(I)%Units = 'J' + case('Q') + m%dll_data%LogChannels_OutParam(I)%Units = 'VAr' + case('T') + m%dll_data%LogChannels_OutParam(I)%Units = 's' + case('VI') + m%dll_data%LogChannels_OutParam(I)%Units = 'VA' + end select + + end do + +END SUBROUTINE GetBladedLoggingChannels +!================================================================================================================================== + !> This routine calls the DLL for the final time (if it was previously called), and frees the dynamic library. SUBROUTINE BladedInterface_End(u, p, m, ErrStat, ErrMsg) @@ -358,17 +658,16 @@ SUBROUTINE BladedInterface_End(u, p, m, ErrStat, ErrMsg) ! call DLL final time, but skip if we've never called it if (allocated(m%dll_data%avrSWAP)) then - IF ( .NOT. EqualRealNos( m%dll_data%avrSWAP( 1), 0.0_SiKi ) ) THEN - m%dll_data%avrSWAP( 1) = -1.0 ! Status flag set as follows: 0 if this is the first call, 1 for all subsequent time steps, -1 if this is the final call at the end of the simulation (-) - !CALL Fill_avrSWAP( -1_IntKi, -10.0_DbKi, u, p, LEN(ErrMsg), m%dll_data ) - - CALL CallBladedDLL(u, p%DLL_Trgt, m%dll_data, p, ErrStat, ErrMsg) + IF ( m%dll_data%SimStatus /= GH_DISCON_STATUS_INITIALISING ) THEN + m%dll_data%SimStatus = GH_DISCON_STATUS_FINALISING + m%dll_data%avrSWAP(1) = m%dll_data%SimStatus ! we aren't calling fill_avrSWAP, so set this manually + CALL CallBladedDLL(u, p, m%dll_data, ErrStat, ErrMsg) END IF end if CALL FreeDynamicLib( p%DLL_Trgt, ErrStat2, ErrMsg2 ) ! this doesn't do anything #ifdef STATIC_DLL_LOAD because p%DLL_Trgt is 0 (NULL) - IF (ErrStat2 /= ErrID_None) THEN - ErrStat = MAX(ErrStat, ErrStat2) + IF (ErrStat2 /= ErrID_None) THEN + ErrStat = MAX(ErrStat, ErrStat2) ErrMsg = TRIM(ErrMsg)//NewLine//TRIM(ErrMsg2) END IF @@ -388,7 +687,7 @@ SUBROUTINE BladedInterface_CalcOutput(t, u, p, m, ErrStat, ErrMsg) ! local variables: INTEGER(IntKi) :: ErrStat2 ! The error status code CHARACTER(ErrMsgLen) :: ErrMsg2 ! The error message, if an error occurred - + character(*), parameter :: RoutineName = 'BladedInterface_CalcOutput' ! Initialize error values: ErrStat = ErrID_None @@ -396,41 +695,31 @@ SUBROUTINE BladedInterface_CalcOutput(t, u, p, m, ErrStat, ErrMsg) ! Set the input values of the avrSWAP array: - CALL Fill_avrSWAP( t, u, p, LEN(ErrMsg), m%dll_data ) - + CALL Fill_CONTROL_vars( t, u, p, LEN(ErrMsg), m%dll_data ) + + #ifdef DEBUG_BLADED_INTERFACE -!CALL WrNumAryFileNR ( 58, (/t/),'1x,ES15.6E2', ErrStat, ErrMsg ) -CALL WrNumAryFileNR ( 58, m%dll_data%avrSWAP,'1x,ES15.6E2', ErrStat, ErrMsg ) +!CALL WrNumAryFileNR ( 58, (/t/),'1x,ES15.6E2', ErrStat2, ErrMsg2 ) +CALL WrNumAryFileNR ( 58, m%dll_data%avrSWAP,'1x,ES15.6E2', ErrStat2, ErrMsg2 ) write(58,'()') #endif - - + ! Call the Bladed-style DLL controller: - CALL CallBladedDLL(u, p%DLL_Trgt, m%dll_data, p, ErrStat, ErrMsg) + CALL CallBladedDLL(u, p, m%dll_data, ErrStat, ErrMsg) IF ( ErrStat >= AbortErrLev ) RETURN #ifdef DEBUG_BLADED_INTERFACE -!CALL WrNumAryFileNR ( 59, (/t/),'1x,ES15.6E2', ErrStat, ErrMsg ) -CALL WrNumAryFileNR ( 59, m%dll_data%avrSWAP,'1x,ES15.6E2', ErrStat, ErrMsg ) +!CALL WrNumAryFileNR ( 59, (/t/),'1x,ES15.6E2', ErrStat2, ErrMsg2 ) +CALL WrNumAryFileNR ( 59, m%dll_data%avrSWAP,'1x,ES15.6E2', ErrStat2, ErrMsg2 ) write(59,'()') #endif - - - !bjj: setting this after the call so that the first call is with avrSWAP(1)=0 [apparently it doesn't like to be called at initialization.... but maybe we can fix that later] - m%dll_data%avrSWAP( 1) = 1.0 ! Status flag set as follows: 0 if this is the first call, 1 for all subsequent time steps, -1 if this is the final call at the end of the simulation (-) - + ! Get the output values from the avrSWAP array: + + CALL CheckDLLReturnValues( p, m%dll_data, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) - CALL Retrieve_avrSWAP( p, m%dll_data, ErrStat2, ErrMsg2 ) - IF ( ErrStat2 /= ErrID_None ) THEN - IF ( ErrStat /= ErrID_None ) ErrMsg = TRIM(ErrMsg)//NewLine - ErrMsg = TRIM(ErrMsg)//TRIM(ErrMsg2) - ErrStat = MAX(ErrStat, ErrStat2) - IF ( ErrStat >= AbortErrLev ) RETURN - END IF - - -END SUBROUTINE BladedInterface_CalcOutput +END SUBROUTINE BladedInterface_CalcOutput !================================================================================================================================== !> This routine fills the avrSWAP array with its inputs, as described in Appendices A and B of the Bladed User Manual of Bladed !! version 3.81. @@ -443,90 +732,76 @@ SUBROUTINE Fill_avrSWAP( t, u, p, ErrMsgSz, dll_data ) TYPE(SrvD_InputType), INTENT(IN ) :: u !< Inputs at t TYPE(SrvD_ParameterType), INTENT(IN ) :: p !< Parameters INTEGER(IntKi), INTENT(IN ) :: ErrMsgSz !< Allowed size of the DLL-returned error message (-) -! REAL(SiKi), INTENT(INOUT) :: avrSWAP(:) ! the SWAP array for the Bladed DLL Interface TYPE(BladedDLLType), INTENT(INOUT) :: dll_data !< data for the Bladed DLL ! local variables: INTEGER(IntKi) :: I ! Loop counter - - !! Set the values of the avrSWAP array that vary during a simulation - - !IF ( StatFlag == 0 ) ! Initialization flag - ! avrSWAP = 0.0 - ! - ! - ! - !ELSE - + !> The following are values ServoDyn sends to the Bladed DLL. !! For variables returned from the DLL, see bladedinterface::retrieve_avrswap. - !dll_data%avrSWAP( 1) = REAL(StatFlag, SiKi) + dll_data%avrSWAP( 1) = dll_data%SimStatus !> * Record 1: Status flag set as follows: 0 if this is the first call, 1 for all subsequent time steps, -1 if this is the final call at the end of the simulation (-) dll_data%avrSWAP( 2) = REAL(t, SiKi) !> * Record 2: Current time (sec) [t in single precision] - dll_data%avrSWAP( 3) = p%DLL_DT !> * Record 3: Communication interval (sec) [in FAST v7 this was \f$ y\_SrvD\%AllOuts(Time) - LastTime \f$, but is now the SrvD DLL_DT parameter] + dll_data%avrSWAP( 3) = dll_data%DLL_DT !> * Record 3: Communication interval (sec) [in FAST v7 this was \f$ y\_SrvD\%AllOuts(Time) - LastTime \f$, but is now the SrvD DLL_DT parameter] dll_data%avrSWAP( 4) = u%BlPitch(1) !> * Record 4: Blade 1 pitch angle (rad) [SrvD input] - dll_data%avrSWAP( 5) = p%Ptch_SetPnt !> * Record 5: Below-rated pitch angle set-point (rad) [SrvD Ptch_SetPnt parameter] - dll_data%avrSWAP( 6) = p%Ptch_Min !> * Record 6: Minimum pitch angle (rad) [SrvD Ptch_Min parameter] - dll_data%avrSWAP( 7) = p%Ptch_Max !> * Record 7: Maximum pitch angle (rad) [SrvD Ptch_Max parameter] - dll_data%avrSWAP( 8) = p%PtchRate_Min !> * Record 8: Minimum pitch rate (most negative value allowed) (rad/s) [SrvD PtchRate_Min parameter] - dll_data%avrSWAP( 9) = p%PtchRate_Max !> * Record 9: Maximum pitch rate (rad/s) [SrvD PtchRate_Max parameter] + dll_data%avrSWAP( 5) = dll_data%Ptch_SetPnt !> * Record 5: Below-rated pitch angle set-point (rad) [SrvD Ptch_SetPnt parameter] + dll_data%avrSWAP( 6) = dll_data%Ptch_Min !> * Record 6: Minimum pitch angle (rad) [SrvD Ptch_Min parameter] + dll_data%avrSWAP( 7) = dll_data%Ptch_Max !> * Record 7: Maximum pitch angle (rad) [SrvD Ptch_Max parameter] + dll_data%avrSWAP( 8) = dll_data%PtchRate_Min !> * Record 8: Minimum pitch rate (most negative value allowed) (rad/s) [SrvD PtchRate_Min parameter] + dll_data%avrSWAP( 9) = dll_data%PtchRate_Max !> * Record 9: Maximum pitch rate (rad/s) [SrvD PtchRate_Max parameter] dll_data%avrSWAP(10) = 0.0 !> * Record 10: 0 = pitch position actuator, 1 = pitch rate actuator (-) [must be 0 for ServoDyn] -!bjj: record 11 technically needs the old demanded values (currently equivalent to this quantity) -! dll_data%avrSWAP(11) = u%BlPitch(1) ! Current demanded pitch angle (rad) -- I am sending the value for blade 1, in the absence of any more information provided in Bladed documentation - dll_data%avrSWAP(11) = dll_data%PrevBlPitch(1) !> * Record 11: Current demanded pitch angle (rad) [I am sending the previous value for blade 1 from the DLL, in the absence of any more information provided in Bladed documentation] + dll_data%avrSWAP(11) = dll_data%BlPitchCom(1) !> * Record 11: Current demanded pitch angle (rad) [I am sending the previous value for blade 1 from the DLL, in the absence of any more information provided in Bladed documentation] dll_data%avrSWAP(12) = 0.0 !> * Record 12: Current demanded pitch rate (rad/s) [always zero for ServoDyn] - dll_data%avrSWAP(13) = p%GenPwr_Dem !> * Record 13: Demanded power (W) [SrvD GenPwr_Dem parameter] + dll_data%avrSWAP(13) = dll_data%GenPwr_Dem !> * Record 13: Demanded power (W) [SrvD GenPwr_Dem parameter from input file] dll_data%avrSWAP(14) = u%RotPwr !> * Record 14: Measured shaft power (W) [SrvD input] - dll_data%avrSWAP(15) = u%ElecPwr_prev !> * Record 15: Measured electrical power output (W) [SrvD input from previous step output; technically should be a state] - !> * Record 16: Optimal mode gain (Nm/(rad/s)^2) [if torque-speed table look-up not selected in input file, use SrvD Gain_OM parameter, otherwise use 0] - IF ( p%DLL_NumTrq == 0 ) THEN ! Torque-speed table look-up not selected - dll_data%avrSWAP(16) = p%Gain_OM ! Optimal mode gain (Nm/(rad/s)^2) - ELSE ! Torque-speed table look-up selected - dll_data%avrSWAP(16) = 0.0 ! Optimal mode gain (Nm/(rad/s)^2) -- 0.0 indicates that torque-speed table look-up is selected - ENDIF - dll_data%avrSWAP(17) = p%GenSpd_MinOM !> * Record 17: Minimum generator speed (rad/s) [SrvD GenSpd_MinOM parameter] - dll_data%avrSWAP(18) = p%GenSpd_MaxOM !> * Record 18: Optimal mode maximum speed (rad/s) [SrvD GenSpd_MaxOMp arameter] - dll_data%avrSWAP(19) = p%GenSpd_Dem !> * Record 19: Demanded generator speed above rated (rad/s) [SrvD GenSpd_Dem parameter] + dll_data%avrSWAP(15) = dll_data%ElecPwr_prev !> * Record 15: Measured electrical power output (W) [SrvD calculation from previous step; should technically be a state] + dll_data%avrSWAP(16) = dll_data%Gain_OM !> * Record 16: Optimal mode gain (Nm/(rad/s)^2) [if torque-speed table look-up not selected in input file, use SrvD Gain_OM parameter, otherwise use 0 (already overwritten in Init routine)] + dll_data%avrSWAP(17) = dll_data%GenSpd_MinOM !> * Record 17: Minimum generator speed (rad/s) [SrvD GenSpd_MinOM parameter] + dll_data%avrSWAP(18) = dll_data%GenSpd_MaxOM !> * Record 18: Optimal mode maximum speed (rad/s) [SrvD GenSpd_MaxOMp arameter] + dll_data%avrSWAP(19) = dll_data%GenSpd_Dem !> * Record 19: Demanded generator speed above rated (rad/s) [SrvD GenSpd_Dem parameter] dll_data%avrSWAP(20) = u%HSS_Spd !> * Record 20: Measured generator speed (rad/s) [SrvD input] dll_data%avrSWAP(21) = u%RotSpeed !> * Record 21: Measured rotor speed (rad/s) [SrvD input] - dll_data%avrSWAP(22) = p%GenTrq_Dem !> * Record 22: Demanded generator torque (Nm) [SrvD GenTrq_Dem parameter] + dll_data%avrSWAP(22) = dll_data%GenTrq_Dem !> * Record 22: Demanded generator torque above rated (Nm) [SrvD GenTrq_Dem parameter from input file] !bjj: this assumes it is the value at the previous step; but we actually want the output GenTrq... - dll_data%avrSWAP(23) = u%GenTrq_prev !> * Record 23: Measured generator torque (Nm) [SrvD input from previous step output; should technically be a state] + dll_data%avrSWAP(23) = dll_data%GenTrq_prev !> * Record 23: Measured generator torque (Nm) [SrvD calculation from previous step; should technically be a state] dll_data%avrSWAP(24) = u%YawErr !> * Record 24: Measured yaw error (rad) [SrvD input] - IF ( p%DLL_NumTrq == 0 ) THEN ! Torque-speed table look-up not selected + IF ( dll_data%DLL_NumTrq == 0 ) THEN ! Torque-speed table look-up not selected dll_data%avrSWAP(25) = 0.0 ! Start of below-rated torque-speed look-up table (record no.) -- 0.0 indicates that torque-speed table look-up is not selected - dll_data%avrSWAP(26) = 0.0 ! No. of points in torque-speed look-up table (-) -- 0.0 indicates that torque-speed table look-up is not selected ELSE ! Torque-speed table look-up selected dll_data%avrSWAP(25) = R !> * Record 25: Start of below-rated torque-speed look-up table (record no.) [parameter \f$R\f$ (bladedinterface::r) or 0 if DLL_NumTrq == 0] - dll_data%avrSWAP(26) = p%DLL_NumTrq !> * Record 26: No. of points in torque-speed look-up table (-) [SrvD DLL_NumTrq parameter] ENDIF + dll_data%avrSWAP(26) = dll_data%DLL_NumTrq !> * Record 26: No. of points in torque-speed look-up table (-) [SrvD DLL_NumTrq parameter] dll_data%avrSWAP(27) = u%HorWindV !> * Record 27: Hub wind speed (m/s) [SrvD input] - dll_data%avrSWAP(28) = p%Ptch_Cntrl !> * Record 28: Pitch control: 0 = collective, 1 = individual (-) [SrvD Ptch_Cntrl parameter] - dll_data%avrSWAP(29) = 0.0 !> * Record 29: Yaw control: 0 = yaw rate control, 1 = yaw torque control (-) [must be 0 for ServoDyn] + dll_data%avrSWAP(28) = dll_data%Ptch_Cntrl !> * Record 28: Pitch control: 0 = collective, 1 = individual (-) [SrvD Ptch_Cntrl parameter] + dll_data%avrSWAP(29) = dll_data%Yaw_Cntrl !> * Record 29: Yaw control: 0 = yaw rate control, 1 = yaw torque control (-) [must be 0 for ServoDyn] !^^^ bjj: maybe torque control can be used in ServoDyn? can we specifiy yaw torque control? dll_data%avrSWAP(30) = u%RootMyc(1) !> * Record 30: Blade 1 root out-of-plane bending moment (Nm) [SrvD input] dll_data%avrSWAP(31) = u%RootMyc(2) !> * Record 31: Blade 2 root out-of-plane bending moment (Nm) [SrvD input] dll_data%avrSWAP(32) = u%RootMyc(3) !> * Record 32: Blade 3 root out-of-plane bending moment (Nm) [SrvD input] +IF ( p%NumBl > 1 ) THEN dll_data%avrSWAP(33) = u%BlPitch(2) !> * Record 33: Blade 2 pitch angle (rad) [SrvD input] -IF ( p%NumBl > 2 ) THEN +END IF +IF ( p%NumBl > 2 ) THEN dll_data%avrSWAP(34) = u%BlPitch(3) !> * Record 34: Blade 3 pitch angle (rad) [SrvD input] +! dll_data%avrSWAP(34) = u%BlPitch(3) !> * Record 34: Blade 3 pitch angle (rad) [SrvD input] END IF dll_data%avrSWAP(35) = dll_data%GenState !> * Record 35: Generator contactor (-) [GenState from previous call to DLL (initialized to 1)] - dll_data%avrSWAP(36) = dll_data%HSSBrFrac !> * Record 36: Shaft brake status: 0 = off, 1 = on (full) (-) [HSSBrFrac from previous call to DLL (initialized to 0)] +! record 36 is initialized to 0 (brake off); then we will keep the brake status set in previous call to DLL +! dll_data%avrSWAP(36) = dll_data%HSSBrFrac !> * Record 36: Shaft brake status: 0 = off, 1 = on (full), 16 = Get brake torque from record 107 (-) [HSSBrFrac from previous call to DLL (initialized to 0)] dll_data%avrSWAP(37) = u%YawAngle - p%NacYaw_North !> * Record 37: Nacelle yaw angle from North (rad) [ \f$ u\%YawAngle - p\%NacYaw\_North \f$ ] ! Records 38-48 are outputs [see Retrieve_avrSWAP()] - dll_data%avrSWAP(49) = REAL( ErrMsgSz ) + 1 !> * Record 49: Maximum number of characters in the "MESSAGE" argument (-) [size of ErrMsg argument plus 1 (we add one for the C NULL CHARACTER)] - dll_data%avrSWAP(50) = REAL( LEN_TRIM(p%DLL_InFile) ) +1 !> * Record 50: Number of characters in the "INFILE" argument (-) [trimmed length of DLL_InFile parameter plus 1 (we add one for the C NULL CHARACTER)] - dll_data%avrSWAP(51) = REAL( LEN_TRIM(p%RootName) ) +1 !> * Record 51: Number of characters in the "OUTNAME" argument (-) [trimmed length of RootName parameter plus 1 (we add one for the C NULL CHARACTER)] + dll_data%avrSWAP(49) = ErrMsgSz + 1 !> * Record 49: Maximum number of characters in the "MESSAGE" argument (-) [size of ErrMsg argument plus 1 (we add one for the C NULL CHARACTER)] + dll_data%avrSWAP(50) = LEN_TRIM(dll_data%DLL_InFile) +1 !> * Record 50: Number of characters in the "INFILE" argument (-) [trimmed length of DLL_InFile parameter plus 1 (we add one for the C NULL CHARACTER)] + dll_data%avrSWAP(51) = LEN_TRIM(dll_data%RootName) +1 !> * Record 51: Number of characters in the "OUTNAME" argument (-) [trimmed length of RootName parameter plus 1 (we add one for the C NULL CHARACTER)] ! Record 52 is reserved for future use ! DLL interface version number (-) dll_data%avrSWAP(53) = u%YawBrTAxp !> * Record 53: Tower top fore-aft acceleration (m/s^2) [SrvD input] dll_data%avrSWAP(54) = u%YawBrTAyp !> * Record 54: Tower top side-to-side acceleration (m/s^2) [SrvD input] ! Records 55-59 are outputs [see Retrieve_avrSWAP()] dll_data%avrSWAP(60) = u%LSSTipPxa !> * Record 60: Rotor azimuth angle (rad) [SrvD input] dll_data%avrSWAP(61) = p%NumBl !> * Record 61: Number of blades (-) [SrvD NumBl parameter] - dll_data%avrSWAP(62) = 0.0 !> * Record 62: Maximum number of values which can be returned for logging (-) [currently set to 0] - dll_data%avrSWAP(63) = 0.0 !> * Record 63: Record number for start of logging output (-) [currently set to 0] - dll_data%avrSWAP(64) = 0.0 !> * Record 64: Maximum number of characters which can be returned in "OUTNAME" (-) [currently set to 0] + dll_data%avrSWAP(62) = MaxLoggingChannels !> * Record 62: Maximum number of values which can be returned for logging (-) [set to parameter bladedinterface::maxloggingchannels] + dll_data%avrSWAP(63) = R + (2*dll_data%DLL_NumTrq) !> * Record 63: Record number for start of logging output (-) [set to R + (2*p\%DLL_NumTrq)] + dll_data%avrSWAP(64) = p%avcOUTNAME_LEN !> * Record 64: Maximum number of characters which can be returned in "OUTNAME" (-) [set to bladedinterface::MaxLoggingChannels * (2+nwtc_base::chanlen) + 1 (we add one for the C NULL CHARACTER)] ! Record 65 is output [see Retrieve_avrSWAP()] ! Records 66-68 are reserved @@ -565,9 +840,9 @@ SUBROUTINE Fill_avrSWAP( t, u, p, ErrMsgSz, dll_data ) dll_data%avrSWAP(117) = 0 !> * Record 117: Controller state [always set to 0] !> * Records \f$R\f$ through \f$R + 2*DLL\_NumTrq - 1\f$: torque-speed look-up table elements. - DO I = 1,p%DLL_NumTrq ! Loop through all torque-speed look-up table elements - dll_data%avrSWAP( R + (2*I) - 2 ) = p%GenSpd_TLU(I) !> + Records \f$R, R+2, R+4, \dots, R + 2*DLL\_NumTrq - 2\f$: Generator speed look-up table elements (rad/s) - dll_data%avrSWAP( R + (2*I) - 1 ) = p%GenTrq_TLU(I) !> + Records \f$R+1, R+3, R+5, \dots, R + 2*DLL\_NumTrq - 1\f$: Generator torque look-up table elements (Nm) + DO I = 1,dll_data%DLL_NumTrq ! Loop through all torque-speed look-up table elements + dll_data%avrSWAP( R + (2*I) - 2 ) = dll_data%GenSpd_TLU(I) !> + Records \f$R, R+2, R+4, \dots, R + 2*DLL\_NumTrq - 2\f$: Generator speed look-up table elements (rad/s) + dll_data%avrSWAP( R + (2*I) - 1 ) = dll_data%GenTrq_TLU(I) !> + Records \f$R+1, R+3, R+5, \dots, R + 2*DLL\_NumTrq - 1\f$: Generator torque look-up table elements (Nm) ENDDO @@ -580,6 +855,73 @@ SUBROUTINE Fill_avrSWAP( t, u, p, ErrMsgSz, dll_data ) RETURN END SUBROUTINE Fill_avrSWAP +!================================================================================================================================== +!> This routine fills the dll_data variables that are used in the non-legacy version of the Bladed DLL interface with inputs, +!! as described in Appendices A and B of the Bladed User Manual of Bladed version 4.8. +SUBROUTINE Fill_CONTROL_vars( t, u, p, ErrMsgSz, dll_data ) + + REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds + TYPE(SrvD_InputType), INTENT(IN ) :: u !< Inputs at t + TYPE(SrvD_ParameterType), INTENT(IN ) :: p !< Parameters + INTEGER(IntKi), INTENT(IN ) :: ErrMsgSz !< Allowed size of the DLL-returned error message (-) +! REAL(SiKi), INTENT(INOUT) :: avrSWAP(:) ! the SWAP array for the Bladed DLL Interface + TYPE(BladedDLLType), INTENT(INOUT) :: dll_data !< data for the Bladed DLL + + ! local variables: + INTEGER(IntKi) :: i ! Loop counter + INTEGER(IntKi) :: j ! Loop counter + + if (dll_data%SimStatus == GH_DISCON_STATUS_INITIALISING) then + dll_data%avrSWAP = 0.0 + dll_data%NumLogChannels = 0 + + dll_data%GenState = 1 + dll_data%GenTrq = 0.0 + dll_data%YawRateCom = 0.0 + dll_data%HSSBrTrqDemand = 0.0 + dll_data%ShaftBrakeStatusBinaryFlag = 0 ! no brakes deployed + dll_data%HSSBrDeployed = .false. + + dll_data%PrevBlPitch(1:p%NumBl) = p%BlPitchInit + dll_data%BlPitchCom(1:p%NumBl) = p%BlPitchInit + end if + + call Fill_avrSWAP( t, u, p, ErrMsgSz, dll_data ) ! we'll set the avrSWAP variable, for the legacy version of the DLL, too. + + !> The following are values ServoDyn sends to the Bladed DLL. + !! For variables returned from the DLL, see bladedinterface::retrieve_control_vars. + + dll_data%ErrMsg = '' + dll_data%ErrStat = ErrID_None + dll_data%OverrideYawRateWithTorque = .false. + + dll_data%CurrentTime = t ! Current time (sec) + dll_data%BlPitchInput(1:p%NumBl) = u%BlPitch(1:p%NumBl) ! current blade pitch (input) + dll_data%YawAngleFromNorth = u%YawAngle - p%NacYaw_North ! Nacelle yaw angle from North (rad) + dll_data%HorWindV = u%HorWindV ! Hub wind speed (m/s) + dll_data%HSS_Spd = u%HSS_Spd ! Measured generator speed (rad/s) + dll_data%YawErr = u%YawErr ! Measured yaw error (rad) + dll_data%RotSpeed = u%RotSpeed ! Measured rotor speed (rad/s) + dll_data%YawBrTAxp = u%YawBrTAxp ! Tower top fore-aft acceleration (m/s^2) + dll_data%YawBrTAyp = u%YawBrTAyp ! Tower top side-to-side acceleration (m/s^2) + dll_data%LSSTipMys = u%LSSTipMys ! Fixed hub My (GL co-ords) (Nm) + dll_data%LSSTipMzs = u%LSSTipMzs ! Fixed hub Mz (GL co-ords) (Nm) + dll_data%LSSTipPxa = u%LSSTipPxa ! Rotor azimuth angle (rad) + dll_data%Yaw = u%Yaw ! Current nacelle yaw (angular position) (rad) NEW TO DLL!!! + dll_data%YawRate = u%YawRate ! Current nacelle yaw rate (angular velocity) (rad/s) NEW TO DLL!!! + dll_data%LSSTipMya = u%LSSTipMya ! Rotating hub My (GL co-ords) (Nm) + dll_data%LSSTipMza = u%LSSTipMza ! Rotating hub Mz (GL co-ords) (Nm) + dll_data%YawBrMyn = u%YawBrMyn ! Yaw bearing My (GL co-ords) (Nm) + dll_data%YawBrMzn = u%YawBrMzn ! Yaw bearing Mz (GL co-ords) (Nm) + dll_data%RotPwr = u%RotPwr ! Measured shaft power (W) [SrvD input] + dll_data%NcIMURAxs = u%NcIMURAxs ! Nacelle roll acceleration (rad/s^2) -- this is in the shaft (tilted) coordinate system, instead of the nacelle (nontilted) coordinate system + dll_data%NcIMURAys = u%NcIMURAys ! Nacelle nodding acceleration (rad/s^2) + dll_data%NcIMURAzs = u%NcIMURAzs ! Nacelle yaw acceleration (rad/s^2) -- this is in the shaft (tilted) coordinate system, instead of the nacelle (nontilted) coordinate system + dll_data%LSSTipMxa = u%LSSTipMxa ! Shaft torque (=hub Mx for clockwise rotor) (Nm) + dll_data%RootMyc = u%RootMyc ! Blade root out-of-plane bending moment (Nm) [SrvD input] + dll_data%RootMxc = u%RootMxc ! Blade root in-plane bending moment (Nm) [SrvD input] + +END SUBROUTINE Fill_CONTROL_vars !================================================================================================================================== !> This routine retrieves the DLL return values from the avrSWAP array, as described in Appendices A and B of the Bladed User !! Manual of Bladed version 3.81. @@ -594,6 +936,7 @@ SUBROUTINE Retrieve_avrSWAP( p, dll_data, ErrStat, ErrMsg ) ! local variables: INTEGER(IntKi) :: K ! Loop counter + CHARACTER(*), PARAMETER :: RoutineName = 'Retrieve_avrSWAP' ! Initialize ErrStat and ErrMsg @@ -611,44 +954,23 @@ SUBROUTINE Retrieve_avrSWAP( p, dll_data, ErrStat, ErrMsg ) !> * Record 35: Generator contactor (-) [sent to DLL at the next call] dll_data%GenState = NINT( dll_data%avrSWAP(35) ) ! Generator contactor (-) - IF ( ( dll_data%GenState /= 0_IntKi ) .AND. ( dll_data%GenState /= 1_IntKi ) ) THEN - - ! Generator contactor indicates something other than off or main; abort program - - IF ( ErrStat /= ErrID_None ) ErrMsg = TRIM(ErrMsg)//NewLine - ErrMsg = TRIM(ErrMsg)//'Only off and main generators supported in '//TRIM( GetNVD( BladedInterface_Ver ) )// & - '. Set avrSWAP(35) to 0 or 1 in '//TRIM(p%DLL_Trgt%FileName)//'.' - ErrStat = ErrID_Fatal - - END IF - !> * Record 36: Shaft brake status (-) [sent to DLL at the next call; anything other than 0 or 1 is an error] - dll_data%HSSBrFrac = dll_data%avrSWAP(36) ! Shaft brake status (-) + !dll_data%HSSBrFrac = dll_data%avrSWAP(36) ! Shaft brake status (-) + dll_data%ShaftBrakeStatusBinaryFlag = NINT(dll_data%avrSWAP(36)) - IF ( ( .NOT. EqualRealNos(dll_data%HSSBrFrac, 0.0_ReKi) ) .AND. & - ( .NOT. EqualRealNos(dll_data%HSSBrFrac, 1.0_ReKi) ) ) THEN - - ! Shaft brake status specified incorrectly; abort program - - IF ( ErrStat /= ErrID_None ) ErrMsg = TRIM(ErrMsg)//NewLine - ErrMsg = TRIM(ErrMsg)//'Shaft brake status improperly set in '//TRIM( GetNVD( BladedInterface_Ver ) )//& - '. Set avrSWAP(36) to 0 or 1 in '//TRIM(p%DLL_Trgt%FileName)//'.' - ErrStat = ErrID_Fatal - - END IF - !! Records 38-40 are reserved !> * Record 41: demanded yaw actuator torque [this output is ignored since record 29 is set to 0 by ServoDyn indicating yaw rate control] + dll_data%YawTorqueDemand = dll_data%avrSWAP(41) ! Records 42-46: demanded pitch positions or rates - IF ( p%Ptch_Cntrl /= 0_IntKi ) THEN ! Individual pitch control (p%Ptch_Cntrl == 1) + IF ( dll_data%Ptch_Cntrl == GH_DISCON_PITCH_CONTROL_INDIVIDUAL ) THEN ! Individual pitch control (p%Ptch_Cntrl == 1) !> * Records 42-44: Demanded Individual Pitch position (rad) (or pitch rate [rad/s]) DO K = 1,p%NumBl ! Loop through all blades avrSWAP(42), avrSWAP(43), and, if NumBl = 3, avrSWAP(44) dll_data%BlPitchCom(K) = dll_data%avrSWAP( 41 + K ) ! Demanded individual pitch position of blade K (rad) ENDDO ! K - blades - ELSE !IF ( p%Ptch_Cntrl == 0_IntKi ) THEN ! Collective pitch control + ELSE !IF ( p%Ptch_Cntrl == GH_DISCON_PITCH_CONTROL_COLLECTIVE ) THEN ! Collective pitch control !> * Record 45: Demanded pitch angle (Collective pitch) (rad) dll_data%BlPitchCom = dll_data%avrSWAP(45) ! Demanded pitch angle (Collective pitch) (rad) @@ -662,39 +984,30 @@ SUBROUTINE Retrieve_avrSWAP( p, dll_data, ErrStat, ErrMsg ) !> * Record 55: Pitch override [anything other than 0 is an error in ServoDyn] IF ( NINT( dll_data%avrSWAP(55) ) /= 0 ) THEN - ! Pitch override requested by DLL; abort program - - IF ( ErrStat /= ErrID_None ) ErrMsg = TRIM(ErrMsg)//NewLine - ErrMsg = TRIM(ErrMsg)//'Built-in pitch unsupported in '//TRIM( GetNVD( BladedInterface_Ver ) )//& - '. Set avrSWAP(55) to 0 in '//TRIM(p%DLL_Trgt%FileName)//'.' - ErrStat = ErrID_Fatal + CALL SetErrStat( ErrID_Severe, 'Built-in pitch override unsupported. Set avrSWAP(55) to 0 in '// & + TRIM(p%DLL_Trgt%FileName)//'.', ErrStat, ErrMsg, RoutineName) + END IF - + !> * Record 56: Torque override IF ( NINT( dll_data%avrSWAP(56) ) /= 0 ) THEN - ! Torque override requested by DLL; abort program - - IF ( ErrStat /= ErrID_None ) ErrMsg = TRIM(ErrMsg)//NewLine - ErrMsg = TRIM(ErrMsg)//'Built-in torque unsupported in '//TRIM( GetNVD( BladedInterface_Ver ) )//& - '. Set avrSWAP(56) to 0 in '//TRIM(p%DLL_Trgt%FileName)//'.' - ErrStat = ErrID_Fatal + CALL SetErrStat( ErrID_Severe, 'Built-in torque override unsupported. Set avrSWAP(56) to 0 in '// & + TRIM(p%DLL_Trgt%FileName)//'.', ErrStat, ErrMsg, RoutineName) + END IF !! Records 57-59 are reserved -!> * Record 65: Number of variables returned for logging [anything other than 0 is an error] - IF ( NINT( dll_data%avrSWAP(65) ) /= 0 ) THEN +!> * Record 65: Number of variables returned for logging [anything greater than MaxLoggingChannels is an error] + IF ( NINT( dll_data%avrSWAP(65) ) > MaxLoggingChannels ) THEN ! Return variables for logging requested by DLL; abort program - - IF ( ErrStat /= ErrID_None ) ErrMsg = TRIM(ErrMsg)//NewLine - ErrMsg = TRIM(ErrMsg)//'Return variables unsupported in '//TRIM( GetNVD( BladedInterface_Ver ) )//& - '. Set avrSWAP(65) to 0 in '//TRIM(p%DLL_Trgt%FileName)//'.' - ErrStat = ErrID_Fatal + CALL SetErrStat( ErrID_Fatal, 'Return variables exceed maximum number allowed. Set avrSWAP(65) to a number no larger than '// & + trim(num2lstr(MaxLoggingChannels))//' in '//TRIM(p%DLL_Trgt%FileName)//'.', ErrStat, ErrMsg, RoutineName) ENDIF @@ -707,10 +1020,21 @@ SUBROUTINE Retrieve_avrSWAP( p, dll_data, ErrStat, ErrMsg ) !> * Record 98: Safety system number to activate; not used in ServoDyn !> * Records 102-104: Yaw control/stiffness/damping; ignored in ServoDyn - -!> * Record 107: Brake torque demand - dll_data%HSSBrTrqC = dll_data%avrSWAP(107) - + if (dll_data%avrSWAP(102)==4) then + dll_data%OverrideYawRateWithTorque = .true. + elseif (dll_data%avrSWAP(102)==0) then + dll_data%OverrideYawRateWithTorque = .false. + else + dll_data%OverrideYawRateWithTorque = .false. + CALL SetErrStat( ErrID_Severe, 'Invalid yaw control flag. Set avrSWAP(102) to 0 or 4 in '// & + TRIM(p%DLL_Trgt%FileName)//'.', ErrStat, ErrMsg, RoutineName) + end if + +!> * Record 107: Brake torque demand (used only when avrSWAP(36) is 16) + if (dll_data%ShaftBrakeStatusBinaryFlag == 16) then + dll_data%HSSBrTrqDemand = dll_data%avrSWAP(107) + end if + !> * Record 108: Yaw brake torque demand; ignored in ServoDyn !> * Records 120-129: User-defined variables 1-10; ignored in ServoDyn @@ -723,10 +1047,80 @@ SUBROUTINE Retrieve_avrSWAP( p, dll_data, ErrStat, ErrMsg ) !> * Records 130-142: Reserved -!> * L1: variables for logging output; not yet implemented in ServoDyn +!> * L1: variables for logging output; + + do k=1,p%NumOuts_DLL + dll_data%LogChannels(k) = dll_data%avrSWAP( NINT(dll_data%avrSWAP(63))+k-1 ) + end do END SUBROUTINE Retrieve_avrSWAP !================================================================================================================================== +!> This routine checks that the values returned to FAST from the controller DLL (from either version of the interface) are valid +SUBROUTINE CheckDLLReturnValues( p, dll_data, ErrStat, ErrMsg ) + + TYPE(SrvD_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(BladedDLLType), INTENT(INOUT) :: dll_data !< data for the Bladed DLL + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + CHARACTER(*), PARAMETER :: RoutineName = 'CheckDLLReturnValues' + + ! Initialize ErrStat and ErrMsg + ErrStat = ErrID_None + ErrMsg = '' + + if (p%UseLegacyInterface) then + CALL Retrieve_avrSWAP( p, dll_data, ErrStat, ErrMsg ) + if (ErrStat >= AbortErrLev) return + end if + + + IF ( ( dll_data%GenState /= 0_IntKi ) .AND. ( dll_data%GenState /= 1_IntKi ) ) THEN + ! Generator contactor indicates something other than off or main; abort program + if (p%UseLegacyInterface) then + CALL SetErrStat( ErrID_Fatal, 'Only off and main generators supported. Set avrSWAP(35) to 0 or 1 in '//TRIM(p%DLL_Trgt%FileName)//'.', ErrStat, ErrMsg, RoutineName) + else + CALL SetErrStat( ErrID_Fatal, 'Only off and main generators supported. Call SetGeneratorContactor() with generator_contactor set to 0 or 1 in '// & + TRIM(p%DLL_Trgt%FileName)//'.', ErrStat, ErrMsg, RoutineName) + end if + END IF + + + SELECT CASE (dll_data%ShaftBrakeStatusBinaryFlag) + CASE (0) + dll_data%HSSBrTrqDemand = 0.0_ReKi + dll_data%HSSBrDeployed = .false. + CASE (1) + if (.not. dll_data%HSSBrDeployed) then + dll_data%TimeHSSBrDeployed = dll_data%CurrentTime + dll_data%TimeHSSBrFullyDeployed = dll_data%TimeHSSBrDeployed + p%HSSBrDT + dll_data%HSSBrDeployed = .true. + dll_data%HSSBrTrqDemand = 0.0_ReKi + else + ! apply a linear ramp up to the maximum value + IF ( dll_data%CurrentTime < dll_data%TimeHSSBrFullyDeployed ) THEN + dll_data%HSSBrTrqDemand = ( dll_data%CurrentTime - dll_data%TimeHSSBrDeployed )/p%HSSBrDT * p%HSSBrTqF + ELSE ! Full braking torque + dll_data%HSSBrTrqDemand = p%HSSBrTqF + ENDIF + end if + CASE (16) + dll_data%HSSBrDeployed = .false. + ! do we need to check that dll_data%HSSBrTrqDemand is set properly???? + CASE DEFAULT + dll_data%HSSBrDeployed = .false. + + ! Fatal issue: shaft brake status specified incorrectly + if (p%UseLegacyInterface) then + CALL SetErrStat( ErrID_Fatal, 'Shaft brake status set improperly. Set avrSWAP(36) to 0, 1, or 16 in '// & + TRIM(p%DLL_Trgt%FileName)//'.', ErrStat, ErrMsg, RoutineName) + else + CALL SetErrStat( ErrID_Fatal, 'Shaft brake status set improperly. Call SetShaftBrakeStatusBinaryFlag() with binary_brake_status set to 0 or 1 in '// & + TRIM(p%DLL_Trgt%FileName)//'.', ErrStat, ErrMsg, RoutineName) + end if + END SELECT + +END SUBROUTINE CheckDLLReturnValues +!================================================================================================================================== END MODULE BladedInterface diff --git a/modules/servodyn/src/ServoDyn.f90 b/modules/servodyn/src/ServoDyn.f90 index b523eea1f7..ac0fd59c83 100644 --- a/modules/servodyn/src/ServoDyn.f90 +++ b/modules/servodyn/src/ServoDyn.f90 @@ -52,11 +52,11 @@ MODULE ServoDyn INTEGER, PARAMETER :: Indx_u_YawRate = 2 INTEGER, PARAMETER :: Indx_u_HSS_Spd = 3 - INTEGER, PARAMETER :: Indx_Y_BlPitchCom(3) = (/1,2,3/) - INTEGER, PARAMETER :: Indx_Y_YawMom = 4 - INTEGER, PARAMETER :: Indx_Y_GenTrq = 5 - INTEGER, PARAMETER :: Indx_Y_ElecPwr = 6 - INTEGER, PARAMETER :: Indx_Y_WrOutput = 6 ! last non-writeoutput variable + INTEGER, PARAMETER, PUBLIC :: SrvD_Indx_Y_BlPitchCom(3) = (/1,2,3/) + INTEGER, PARAMETER, PUBLIC :: SrvD_Indx_Y_YawMom = 4 + INTEGER, PARAMETER, PUBLIC :: SrvD_Indx_Y_GenTrq = 5 + INTEGER, PARAMETER, PUBLIC :: SrvD_Indx_Y_ElecPwr = 6 + INTEGER, PARAMETER, PUBLIC :: SrvD_Indx_Y_WrOutput = 6 ! last non-writeoutput variable ! =================================================================================================== ! NOTE: The following lines of code were generated by a Matlab script called "Write_ChckOutLst.m" @@ -120,7 +120,7 @@ MODULE ServoDyn INTEGER(IntKi), PARAMETER :: TTMD_YQD = 15 ! Airfoil Control (might be used for flap actuation): - + INTEGER(IntKi), PARAMETER :: BlAirFlC1 = 16 INTEGER(IntKi), PARAMETER :: BlAirFlC2 = 17 INTEGER(IntKi), PARAMETER :: BlAirFlC3 = 18 @@ -145,6 +145,10 @@ MODULE ServoDyn INTEGER(IntKi), PARAMETER :: ControlMode_EXTERN = 4 !< The (ServoDyn-universal) control code for obtaining the control values from Simulink or Labivew INTEGER(IntKi), PARAMETER :: ControlMode_DLL = 5 !< The (ServoDyn-universal) control code for obtaining the control values from a Bladed-Style dynamic-link library + INTEGER(IntKi), PARAMETER, PUBLIC :: TrimCase_none = 0 + INTEGER(IntKi), PARAMETER, PUBLIC :: TrimCase_yaw = 1 + INTEGER(IntKi), PARAMETER, PUBLIC :: TrimCase_torque = 2 + INTEGER(IntKi), PARAMETER, PUBLIC :: TrimCase_pitch = 3 ! ..... Public Subroutines ................................................................................................... @@ -207,6 +211,7 @@ SUBROUTINE SrvD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitO TYPE(TMD_InitInputType) :: TMD_InitInp ! data to initialize TMD module TYPE(TMD_InitOutputType) :: TMD_InitOut ! data from TMD module initialization (not used) INTEGER(IntKi) :: i ! loop counter + INTEGER(IntKi) :: j ! loop counter INTEGER(IntKi) :: ErrStat2 ! temporary Error status of the operation CHARACTER(ErrMsgLen) :: ErrMsg2 ! temporary Error message if ErrStat /= ErrID_None @@ -233,11 +238,11 @@ SUBROUTINE SrvD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitO p%RootName = InitInp%Rootname ! FAST adds the '.SrvD' before calling this module p%NumBl = InitInp%NumBl - CALL SrvD_ReadInput( InitInp%InputFile, InputFileData, Interval, p%RootName, ErrStat2, ErrMsg2 ) + CALL SrvD_ReadInput( InitInp, InputFileData, Interval, p%RootName, ErrStat2, ErrMsg2 ) CALL CheckError( ErrStat2, ErrMsg2 ) IF (ErrStat >= AbortErrLev) RETURN - - CALL ValidatePrimaryData( InitInp, InputFileData, InitInp%NumBl, ErrStat2, ErrMsg2 ) + + CALL ValidatePrimaryData( InitInp, InputFileData, ErrStat2, ErrMsg2 ) CALL CheckError( ErrStat2, ErrMsg2 ) IF (ErrStat >= AbortErrLev) RETURN @@ -250,7 +255,7 @@ SUBROUTINE SrvD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitO !............................................................................................ ! Define parameters here: !............................................................................................ - CALL SrvD_SetParameters( InputFileData, p, ErrStat2, ErrMsg2 ) + CALL SrvD_SetParameters( InputFileData, p, ErrStat2, ErrMsg2 ) CALL CheckError( ErrStat2, ErrMsg2 ) IF (ErrStat >= AbortErrLev) RETURN !p%DT = Interval @@ -374,24 +379,12 @@ SUBROUTINE SrvD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitO u%RotPwr = 0. u%HorWindV = 0. u%YawAngle = 0. - u%ElecPwr_prev = 0. - u%GenTrq_prev = 0. + m%dll_data%ElecPwr_prev = 0. + m%dll_data%GenTrq_prev = 0. - ! These are values from previous step. I'll initialize them here, though the glue code may not use it. - ! @TODO: these need to be removed because they break the framework (though they're only for the Bladed-style - ! DLL which also breaks the frameowrk) - y%ElecPwr = u%ElecPwr_prev - y%GenTrq = u%GenTrq_prev - - !............................................................................................ ! Define system output initializations (set up mesh) here: !............................................................................................ - CALL AllocAry( y%WriteOutput, p%NumOuts, 'WriteOutput', ErrStat2, ErrMsg2 ) - CALL CheckError( ErrStat2, ErrMsg2 ) - IF (ErrStat >= AbortErrLev) RETURN - y%WriteOutput = 0 - CALL AllocAry( y%BlPitchCom, p%NumBl, 'BlPitchCom', ErrStat2, ErrMsg2 ) CALL CheckError( ErrStat2, ErrMsg2 ) IF (ErrStat >= AbortErrLev) RETURN @@ -417,34 +410,6 @@ SUBROUTINE SrvD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitO END IF - !............................................................................................ - ! Define initialization-routine output here: - !............................................................................................ - CALL AllocAry( InitOut%WriteOutputHdr, p%NumOuts, 'WriteOutputHdr', ErrStat2, ErrMsg2 ) - CALL CheckError( ErrStat2, ErrMsg2 ) - IF (ErrStat >= AbortErrLev) RETURN - CALL AllocAry( InitOut%WriteOutputUnt, p%NumOuts, 'WriteOutputUnt', ErrStat2, ErrMsg2 ) - CALL CheckError( ErrStat2, ErrMsg2 ) - IF (ErrStat >= AbortErrLev) RETURN - - do i=1,p%NumOuts - InitOut%WriteOutputHdr(i) = p%OutParam(i)%Name - InitOut%WriteOutputUnt(i) = p%OutParam(i)%Units - end do - - - InitOut%Ver = SrvD_Ver - - InitOut%UseHSSBrake = p%HSSBrMode /= ControlMode_None .AND. p%THSSBrDp < InitInp%TMax - - IF ( p%UseBladedInterface .OR. InitOut%UseHSSBrake ) THEN - InitOut%CouplingScheme = ExplicitLoose - ! CALL CheckError( ErrID_Info, 'The external dynamic-link library option being used in ServoDyn '& - ! //'requires an explicit-loose coupling scheme.' ) - ELSE - InitOut%CouplingScheme = ExplicitLoose - END IF - !............................................................................................ ! tip brakes - this may be added back, later, so we'll keep these here for now !............................................................................................ @@ -485,18 +450,19 @@ SUBROUTINE SrvD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitO IF ( p%UseBladedInterface ) THEN - p%AirDens = InitInp%AirDens + p%AirDens = InitInp%AirDens p%AvgWindSpeed = InitInp%AvgWindSpeed - CALL BladedInterface_Init(u, p, m, y, InputFileData, ErrStat2, ErrMsg2 ) + CALL BladedInterface_Init(u, p, m, y, InputFileData, InitInp, ErrStat2, ErrMsg2 ) CALL CheckError( ErrStat2, ErrMsg2 ) IF (ErrStat >= AbortErrLev) RETURN - m%LastTimeCalled = - p%DLL_DT ! we'll initialize the last time the DLL was called as -1 DLL_DT. + m%LastTimeCalled = - m%dll_data%DLL_DT ! we'll initialize the last time the DLL was called as -1 DLL_DT. m%LastTimeFiltered = - p%DT ! we'll initialize the last time the DLL was filtered as -1 DT. m%FirstWarn = .TRUE. - ELSE + m%dll_data%DLL_DT = p%DT ! DLL_DT is used to compute the pitch rate and acceleration outputs + p%DLL_n = 1 ! Without a call to the DLL, update the history every time step p%DLL_Trgt%FileName = "" p%DLL_Trgt%ProcName = "" @@ -551,36 +517,40 @@ SUBROUTINE SrvD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitO !............................................................................................ ! Set Init outputs for linearization (after TMD, in case we ever add the TMD to the linearization features): !............................................................................................ - + xd%CtrlOffset = 0.0_ReKi ! initialize before first use with TrimCase in linearization + p%TrimCase = InitInp%TrimCase + p%TrimGain = InitInp%TrimGain + p%RotSpeedRef = InitInp%RotSpeedRef + if (InitInp%Linearize) then ! If the module does allow linearization, return the appropriate Jacobian row/column names here: ! Allocate and set these variables: InitOut%LinNames_y, InitOut%LinNames_x, InitOut%LinNames_xd, InitOut%LinNames_z, InitOut%LinNames_u - CALL AllocAry( InitOut%RotFrame_y, 6+p%NumOuts, 'RotFrame_y', ErrStat2, ErrMsg2 ) + CALL AllocAry( InitOut%RotFrame_y, SrvD_Indx_Y_WrOutput+p%NumOuts, 'RotFrame_y', ErrStat2, ErrMsg2 ) CALL CheckError( ErrStat2, ErrMsg2 ) IF (ErrStat >= AbortErrLev) RETURN - CALL AllocAry( InitOut%LinNames_y, 6+p%NumOuts, 'LinNames_y', ErrStat2, ErrMsg2 ) + CALL AllocAry( InitOut%LinNames_y, SrvD_Indx_Y_WrOutput+p%NumOuts, 'LinNames_y', ErrStat2, ErrMsg2 ) CALL CheckError( ErrStat2, ErrMsg2 ) IF (ErrStat >= AbortErrLev) RETURN - do i=1,size(Indx_Y_BlPitchCom) - InitOut%LinNames_y(Indx_Y_BlPitchCom(i)) = 'BlPitchCom('//trim(num2lstr(i))//'), rad' - InitOut%RotFrame_y(Indx_Y_BlPitchCom(i)) = .true. + do i=1,size(SrvD_Indx_Y_BlPitchCom) + InitOut%LinNames_y(SrvD_Indx_Y_BlPitchCom(i)) = 'BlPitchCom('//trim(num2lstr(i))//'), rad' + InitOut%RotFrame_y(SrvD_Indx_Y_BlPitchCom(i)) = .true. end do - InitOut%LinNames_y(Indx_Y_YawMom) = 'YawMom, Nm' - InitOut%RotFrame_y(Indx_Y_YawMom) = .false. + InitOut%LinNames_y(SrvD_Indx_Y_YawMom) = 'YawMom, Nm' + InitOut%RotFrame_y(SrvD_Indx_Y_YawMom) = .false. - InitOut%LinNames_y(Indx_Y_GenTrq) = 'GenTrq, Nm' - InitOut%RotFrame_y(Indx_Y_GenTrq) = .false. + InitOut%LinNames_y(SrvD_Indx_Y_GenTrq) = 'GenTrq, Nm' + InitOut%RotFrame_y(SrvD_Indx_Y_GenTrq) = .false. + + InitOut%LinNames_y(SrvD_Indx_Y_ElecPwr) = 'ElecPwr, W' + InitOut%RotFrame_y(SrvD_Indx_Y_ElecPwr) = .false. - InitOut%LinNames_y(Indx_Y_ElecPwr) = 'ElecPwr, W' - InitOut%RotFrame_y(Indx_Y_ElecPwr) = .false. - do i=1,p%NumOuts - InitOut%LinNames_y(i+Indx_Y_WrOutput) = trim(p%OutParam(i)%Name)//', '//p%OutParam(i)%Units - InitOut%RotFrame_y(i+Indx_Y_WrOutput) = ANY( p%OutParam(i)%Indx == BlPitchC ) ! the only WriteOutput values in the rotating frame are BlPitch commands + InitOut%LinNames_y(i+SrvD_Indx_Y_WrOutput) = trim(p%OutParam(i)%Name)//', '//p%OutParam(i)%Units + InitOut%RotFrame_y(i+SrvD_Indx_Y_WrOutput) = ANY( p%OutParam(i)%Indx == BlPitchC ) ! the only WriteOutput values in the rotating frame are BlPitch commands end do @@ -601,8 +571,52 @@ SUBROUTINE SrvD_Init( InitInp, u, p, x, xd, z, OtherState, y, m, Interval, InitO InitOut%LinNames_u(Indx_u_HSS_Spd) = 'HSS_Spd, rad/s' InitOut%RotFrame_u = .false. ! none of these are in the rotating frame InitOut%IsLoad_u = .false. ! none of these linearization inputs are loads - + + else + + p%TrimCase = TrimCase_none + end if + + + !............................................................................................ + ! Define initialization-routine output here: + !............................................................................................ + CALL AllocAry( y%WriteOutput, p%NumOuts+p%NumOuts_DLL, 'WriteOutput', ErrStat2, ErrMsg2 ) + CALL CheckError( ErrStat2, ErrMsg2 ) + IF (ErrStat >= AbortErrLev) RETURN + y%WriteOutput = 0 + + CALL AllocAry( InitOut%WriteOutputHdr, p%NumOuts+p%NumOuts_DLL, 'WriteOutputHdr', ErrStat2, ErrMsg2 ) + CALL CheckError( ErrStat2, ErrMsg2 ) + IF (ErrStat >= AbortErrLev) RETURN + CALL AllocAry( InitOut%WriteOutputUnt, p%NumOuts+p%NumOuts_DLL, 'WriteOutputUnt', ErrStat2, ErrMsg2 ) + CALL CheckError( ErrStat2, ErrMsg2 ) + IF (ErrStat >= AbortErrLev) RETURN + + do i=1,p%NumOuts + InitOut%WriteOutputHdr(i) = p%OutParam(i)%Name + InitOut%WriteOutputUnt(i) = p%OutParam(i)%Units + end do + + j=p%NumOuts + do i=1,p%NumOuts_DLL + j = j + 1 + InitOut%WriteOutputHdr(j) = m%dll_data%LogChannels_OutParam(i)%Name + InitOut%WriteOutputUnt(j) = m%dll_data%LogChannels_OutParam(i)%Units + end do + + InitOut%Ver = SrvD_Ver + + InitOut%UseHSSBrake = (p%HSSBrMode /= ControlMode_None .AND. p%THSSBrDp < InitInp%TMax) .or. p%HSSBrMode == ControlMode_DLL + + IF ( p%UseBladedInterface .OR. InitOut%UseHSSBrake ) THEN + InitOut%CouplingScheme = ExplicitLoose + ! CALL CheckError( ErrID_Info, 'The external dynamic-link library option being used in ServoDyn '& + ! //'requires an explicit-loose coupling scheme.' ) + ELSE + InitOut%CouplingScheme = ExplicitLoose + END IF !............................................................................................ @@ -752,6 +766,7 @@ SUBROUTINE SrvD_UpdateStates( t, n, Inputs, InputTimes, p, x, xd, z, OtherState, INTEGER(IntKi) :: i ! loop counter INTEGER(IntKi) :: order TYPE(SrvD_InputType) :: u_interp ! interpolated input + ! Local variables: INTEGER(IntKi) :: ErrStat2 ! Error status of the operation (occurs after initial error) @@ -825,34 +840,51 @@ SUBROUTINE SrvD_UpdateStates( t, n, Inputs, InputTimes, p, x, xd, z, OtherState, END IF - ! Get appropriate value of input for the filter in discrete states - ! this works only for the DLL at this point, so we're going to move it there>>>>>>>>>>>>>>> - - ! - !CALL SrvD_UpdateDiscState( t, u_interp, p, x, xd, z, OtherState, ErrStat2, ErrMsg2 ) - ! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) - !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< - !............................................................................................................................... - ! get inputs at t+dt: + ! get inputs at t: !............................................................................................................................... - t_next = t+p%dt - CALL SrvD_CopyInput( Inputs(1), u_interp, MESH_NEWCOPY, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (ErrStat >= AbortErrLev) THEN CALL Cleanup() RETURN END IF + + CALL SrvD_Input_ExtrapInterp( Inputs, InputTimes, u_interp, t, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + !............................................................................................................................... + ! update discrete states: + !............................................................................................................................... + ! 1. Get appropriate value of input for the filter in discrete states (this works only for the DLL at this point, so we're going to move it there) + ! 2. Update control offset for trim solutions + + CALL SrvD_UpdateDiscState( t, u_interp, p, x, xd, z, OtherState, m, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + !............................................................................................................................... + ! get inputs at t+dt: + !............................................................................................................................... + t_next = t+p%dt + CALL SrvD_Input_ExtrapInterp( Inputs, InputTimes, u_interp, t_next, ErrStat2, ErrMsg2 ) - CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + IF (p%UseBladedInterface) THEN + CALL DLL_controller_call(t_next, u_interp, p, x, xd, z, OtherState, m, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + IF (ErrStat >= AbortErrLev) THEN + CALL Cleanup() + RETURN + END IF + END IF !............................................................................................................................... ! update remaining states to values at t+dt: !............................................................................................................................... - ! Torque control + ! Torque control: CALL Torque_UpdateStates( t_next, u_interp, p, x, xd, z, OtherState, m, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) @@ -869,6 +901,23 @@ SUBROUTINE SrvD_UpdateStates( t, n, Inputs, InputTimes, p, x, xd, z, OtherState, CALL TipBrake_UpdateStates( t_next, u_interp, p, x, xd, z, OtherState, m, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + + !................................................................... + ! Compute ElecPwr and GenTrq for controller (and DLL needs this saved): + !................................................................... + IF ( OtherState%GenOnLine .and. .not. OtherState%Off4Good ) THEN ! Generator is on line. + CALL CalculateTorque( t, u_interp, p, m, m%dll_data%GenTrq_prev, m%dll_data%ElecPwr_prev, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + IF (ErrStat >= AbortErrLev) THEN + CALL Cleanup() + RETURN + END IF + ELSE ! Generator is off line. + m%dll_data%GenTrq_prev = 0.0_ReKi + m%dll_data%ElecPwr_prev = 0.0_ReKi + ENDIF + !............................................................................................................................... CALL Cleanup() @@ -892,6 +941,61 @@ END SUBROUTINE Cleanup END SUBROUTINE SrvD_UpdateStates !---------------------------------------------------------------------------------------------------------------------------------- +!> Routine for deciding if Bladed-style DLL controller should be called +SUBROUTINE DLL_controller_call(t, u, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) +!.................................................................................................................................. + + REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds + TYPE(SrvD_InputType), INTENT(IN ) :: u !< Inputs at t + TYPE(SrvD_ParameterType), INTENT(IN ) :: p !< Parameters + TYPE(SrvD_ContinuousStateType), INTENT(IN ) :: x !< Continuous states at t + TYPE(SrvD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at t + TYPE(SrvD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t + TYPE(SrvD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at t + TYPE(SrvD_MiscVarType), INTENT(INOUT) :: m !< Misc (optimization) variables + INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation + CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None + + + INTEGER(IntKi) :: ErrStat2 + CHARACTER(ErrMsgLen) :: ErrMsg2 + CHARACTER(*), PARAMETER :: RoutineName = 'DLL_controller_call' + + + ! Initialize ErrStat + + ErrStat = ErrID_None + ErrMsg = "" + + ! we should be calling this routine ONLY when the following statement is true: + !IF ( p%UseBladedInterface ) THEN + + IF ( .NOT. EqualRealNos( t - m%dll_data%DLL_DT, m%LastTimeCalled ) ) THEN + IF (m%FirstWarn) THEN + IF ( EqualRealNos( p%DT, m%dll_data%DLL_DT ) ) THEN ! This must be because we're doing a correction step or calling multiple times per time step + CALL SetErrStat ( ErrID_Warn, 'BladedInterface option was designed for an explicit-loose '//& + 'coupling scheme. Using last calculated values from DLL on all subsequent calls until time is advanced. '//& + 'Warning will not be displayed again.', ErrStat, ErrMsg, RoutineName ) + ELSE ! this may be because of calling multiple times per time step, but most likely is because DT /= DLL_DT + CALL SetErrStat ( ErrID_Warn, 'Using last calculated values from DLL on all subsequent calls until next DLL_DT has been reached. '//& + 'Warning will not be displayed again.', ErrStat, ErrMsg, RoutineName ) + END IF + m%FirstWarn = .FALSE. + END IF + ELSE + m%dll_data%PrevBlPitch(1:p%NumBl) = m%dll_data%BlPitchCom ! used for linear ramp of delayed signal + m%LastTimeCalled = t + + CALL BladedInterface_CalcOutput( t, u, p, m, ErrStat2, ErrMsg2 ) + CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + + m%dll_data%initialized = .true. + END IF + + !END IF + +END SUBROUTINE DLL_controller_call +!---------------------------------------------------------------------------------------------------------------------------------- !> Routine for computing outputs, used in both loose and tight coupling. SUBROUTINE SrvD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) !.................................................................................................................................. @@ -937,23 +1041,10 @@ SUBROUTINE SrvD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ! Get the demanded values from the external Bladed dynamic link library, if necessary: !............................................................................................................................... IF ( p%UseBladedInterface ) THEN - - IF ( .NOT. EqualRealNos( t - p%DLL_DT, m%LastTimeCalled ) ) THEN - IF (m%FirstWarn) THEN - IF ( EqualRealNos( p%DT, p%DLL_DT ) ) THEN ! This must be because we're doing a correction step or calling multiple times per time step - CALL SetErrStat ( ErrID_Warn, 'BladedInterface option was designed for an explicit-loose '//& - 'coupling scheme. Using last calculated values from DLL on all subsequent calls until time is advanced. '//& - 'Warning will not be displayed again.', ErrStat, ErrMsg, RoutineName ) - ELSE ! this may be because of calling multiple times per time step, but most likely is because DT /= DLL_DT - CALL SetErrStat ( ErrID_Warn, 'Using last calculated values from DLL on all subsequent calls until next DLL_DT has been reached. '//& - 'Warning will not be displayed again.', ErrStat, ErrMsg, RoutineName ) - END IF - m%FirstWarn = .FALSE. - END IF - ELSE - m%dll_data%PrevBlPitch(1:p%NumBl) = m%dll_data%BlPitchCom ! used for linear ramp of delayed signal - m%LastTimeCalled = t - CALL BladedInterface_CalcOutput( t, u, p, m, ErrStat2, ErrMsg2 ) + + ! Initialize the DLL controller in CalcOutput ONLY if it hasn't already been initialized in SrvD_UpdateStates + IF (.NOT. m%dll_data%initialized) THEN + CALL DLL_controller_call(t, u, p, x, xd, z, OtherState, m, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) END IF @@ -966,8 +1057,8 @@ SUBROUTINE SrvD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg y%SuperController = m%dll_data%SCoutput END IF - END IF - + END IF + !............................................................................................................................... ! Compute the outputs !............................................................................................................................... @@ -978,7 +1069,7 @@ SUBROUTINE SrvD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg IF (ErrStat >= AbortErrLev) RETURN ! Pitch control: - CALL Pitch_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat2, ErrMsg2 ) + CALL Pitch_CalcOutput( t, u, p, x, xd, z, OtherState, y%BlPitchCom, y%ElecPwr, m, ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (ErrStat >= AbortErrLev) RETURN @@ -992,6 +1083,15 @@ SUBROUTINE SrvD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (ErrStat >= AbortErrLev) RETURN + + !............................................................................................................................... + ! Calculate all of the available output channels: + !............................................................................................................................... + ! This is overwriting the values if it was called from UpdateStates, but they + ! should be the same and this sets the values if we called the DLL above. + m%dll_data%ElecPwr_prev = y%ElecPwr + m%dll_data%GenTrq_prev = y%GenTrq + !............................................................................................................................... ! Calculate all of the available output channels: !............................................................................................................................... @@ -1002,10 +1102,10 @@ SUBROUTINE SrvD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg AllOuts(HSSBrTqC)= 0.001*y%HSSBrTrqC DO K=1,p%NumBl - AllOuts( BlPitchC(K) ) = y%BlPitchCom(K)*R2D + AllOuts( BlPitchC(K) ) = y%BlPitchCom(K)*R2D AllOuts( BlAirfoilC(K) ) = y%BlAirfoilCom(K) - END DO - + END DO + AllOuts(YawMomCom) = -0.001*y%YawMom AllOuts(NTMD_XQ ) = x%NTMD%tmd_x(1) @@ -1028,6 +1128,10 @@ SUBROUTINE SrvD_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ENDDO ! I - All selected output channels + DO I = 1,p%NumOuts_DLL ! Loop through all DLL logging channels + y%WriteOutput(I+p%NumOuts) = m%dll_data%LogChannels( I ) + ENDDO + RETURN END SUBROUTINE SrvD_CalcOutput !---------------------------------------------------------------------------------------------------------------------------------- @@ -1093,12 +1197,22 @@ SUBROUTINE SrvD_UpdateDiscState( t, u, p, x, xd, z, OtherState, m, ErrStat, ErrM ErrStat = ErrID_None ErrMsg = "" + + select case (p%TrimCase) + case (TrimCase_yaw) + xd%CtrlOffset = xd%CtrlOffset + (u%RotSpeed - p%RotSpeedRef) * sign(p%TrimGain, p%YawNeut + xd%CtrlOffset) + case (TrimCase_torque, TrimCase_pitch) + xd%CtrlOffset = xd%CtrlOffset + (u%RotSpeed - p%RotSpeedRef) * p%TrimGain +! case default +! xd%CtrlOffset = 0.0_ReKi ! same as initialized value + end select + !xd%BlPitchFilter = p%BlAlpha * xd%BlPitchFilter + (1.0_ReKi - p%BlAlpha) * u%BlPitch !if ( p%PCMode == ControlMode_DLL ) then ! if ( p%DLL_Ramp ) then - ! temp = (t - m%LastTimeCalled) / p%DLL_DT + ! temp = (t - m%LastTimeCalled) / m%dll_data%DLL_DT ! temp = m%dll_data%PrevBlPitch(1:p%NumBl) + & ! temp * ( m%dll_data%BlPitchCom(1:p%NumBl) - m%dll_data%PrevBlPitch(1:p%NumBl) ) ! else @@ -1199,9 +1313,8 @@ SUBROUTINE SrvD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, Er ! local variables REAL(R8Ki) :: AllOuts(3,1:MaxOutPts) ! All the the available output channels - REAL(R8Ki) :: GenTrq, ElecPwr ! derivatives of generator torque and electrical power w.r.t. u%HSS_SPD + REAL(R8Ki) :: GenTrq_du, ElecPwr_du ! derivatives of generator torque and electrical power w.r.t. u%HSS_SPD INTEGER(IntKi) :: I ! Generic loop index - INTEGER(IntKi) :: K ! Blade index INTEGER(IntKi) :: ErrStat2 ! Error status of the operation CHARACTER(ErrMsgLen) :: ErrMsg2 ! Error message if ErrStat /= ErrID_None CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_JacobianPInput' @@ -1239,7 +1352,7 @@ SUBROUTINE SrvD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, Er ! Note this is similiar to SrvD_CalcOutput if (.not. allocated(dYdu)) then - call allocAry(dYdu, 6+p%NumOuts, 3, 'dYdu', ErrStat2, ErrMsg2) + call allocAry(dYdu, SrvD_Indx_Y_WrOutput+p%NumOuts, 3, 'dYdu', ErrStat2, ErrMsg2) call SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) end if dYdu = 0.0_R8Ki @@ -1249,10 +1362,10 @@ SUBROUTINE SrvD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, Er !> Compute !> \f$ \frac{\partial Y_{GenTrq}}{\partial u_{HSS\_Spd}} \f$ and !> \f$ \frac{\partial Y_{ElecPwr}}{\partial u_{HSS\_Spd}} \f$ in servodyn::torque_jacobianpinput. - call Torque_JacobianPInput( t, u, p, x, xd, z, OtherState, m, GenTrq, ElecPwr, ErrStat, ErrMsg ) ! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) + call Torque_JacobianPInput( t, u, p, x, xd, z, OtherState, m, GenTrq_du, ElecPwr_du, ErrStat, ErrMsg ) ! CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (ErrStat >= AbortErrLev) RETURN - dYdu(Indx_Y_GenTrq, Indx_u_HSS_Spd) = GenTrq - dYdu(Indx_Y_ElecPwr,Indx_u_HSS_Spd) = ElecPwr + dYdu(SrvD_Indx_Y_GenTrq, Indx_u_HSS_Spd) = GenTrq_du + dYdu(SrvD_Indx_Y_ElecPwr,Indx_u_HSS_Spd) = ElecPwr_du ! Pitch control: @@ -1260,9 +1373,9 @@ SUBROUTINE SrvD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, Er ! Yaw control: !> \f$ \frac{\partial Y_{YawMom}}{\partial u_{Yaw}} = -p\%YawSpr \f$ - dYdu(Indx_Y_YawMom,Indx_u_Yaw) = -p%YawSpr ! from Yaw_CalcOutput + dYdu(SrvD_Indx_Y_YawMom,Indx_u_Yaw) = -p%YawSpr ! from Yaw_CalcOutput !> \f$ \frac{\partial Y_{YawMom}}{\partial u_{YawRate}} = -p\%YawDamp \f$ - dYdu(Indx_Y_YawMom,Indx_u_YawRate) = -p%YawDamp ! from Yaw_CalcOutput + dYdu(SrvD_Indx_Y_YawMom,Indx_u_YawRate) = -p%YawDamp ! from Yaw_CalcOutput !......................................................................................................................... @@ -1270,16 +1383,16 @@ SUBROUTINE SrvD_JacobianPInput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, Er !......................................................................................................................... AllOuts = 0.0_R8Ki ! all variables not specified below are zeros (either constant or disabled): - AllOuts(:, GenTq) = 0.001_R8Ki*dYdu(Indx_Y_GenTrq,:) - AllOuts(:, GenPwr) = 0.001_R8Ki*dYdu(Indx_Y_ElecPwr,:) - AllOuts(:, YawMomCom) = dYdu(Indx_Y_YawMom,:) + AllOuts(:, GenTq) = 0.001_R8Ki*dYdu(SrvD_Indx_Y_GenTrq,:) + AllOuts(:, GenPwr) = 0.001_R8Ki*dYdu(SrvD_Indx_Y_ElecPwr,:) + AllOuts(:, YawMomCom) = -0.001_R8Ki*dYdu(SrvD_Indx_Y_YawMom,:) !............................................................................................................................... ! Place the selected output channels into the WriteOutput(:) portion of the jacobian with the proper sign: !............................................................................................................................... DO I = 1,p%NumOuts ! Loop through all selected output channels - dYdu(I+Indx_Y_WrOutput,:) = p%OutParam(I)%SignM * AllOuts( :, p%OutParam(I)%Indx ) + dYdu(I+SrvD_Indx_Y_WrOutput,:) = p%OutParam(I)%SignM * AllOuts( :, p%OutParam(I)%Indx ) ENDDO ! I - All selected output channels END IF @@ -1578,21 +1691,21 @@ SUBROUTINE SrvD_GetOP( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg, u_o IF ( PRESENT( y_op ) ) THEN if (.not. allocated(y_op)) then - CALL AllocAry( y_op, 6+p%NumOuts, 'y_op', ErrStat2, ErrMsg2 ) + CALL AllocAry( y_op, SrvD_Indx_Y_WrOutput+p%NumOuts, 'y_op', ErrStat2, ErrMsg2 ) CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName ) IF (ErrStat >= AbortErrLev) RETURN end if - do i=1,size(Indx_Y_BlPitchCom) - y_op(Indx_Y_BlPitchCom(i)) = y%BlPitchCom(i) + do i=1,size(SrvD_Indx_Y_BlPitchCom) + y_op(SrvD_Indx_Y_BlPitchCom(i)) = y%BlPitchCom(i) end do - y_op(Indx_Y_YawMom) = y%YawMom - y_op(Indx_Y_GenTrq) = y%GenTrq - y_op(Indx_Y_ElecPwr) = y%ElecPwr + y_op(SrvD_Indx_Y_YawMom) = y%YawMom + y_op(SrvD_Indx_Y_GenTrq) = y%GenTrq + y_op(SrvD_Indx_Y_ElecPwr) = y%ElecPwr do i=1,p%NumOuts - y_op(i+Indx_Y_WrOutput) = y%WriteOutput(i) - end do + y_op(i+SrvD_Indx_Y_WrOutput) = y%WriteOutput(i) + end do END IF @@ -1620,13 +1733,13 @@ END SUBROUTINE SrvD_GetOP !---------------------------------------------------------------------------------------------------------------------------------- !> This subroutine reads the input file and stores all the data in the SrvD_InputFile structure. !! It does not perform data validation. -SUBROUTINE SrvD_ReadInput( InputFileName, InputFileData, Default_DT, OutFileRoot, ErrStat, ErrMsg ) +SUBROUTINE SrvD_ReadInput( InitInp, InputFileData, Default_DT, OutFileRoot, ErrStat, ErrMsg ) !.................................................................................................................................. ! Passed variables + TYPE(SrvD_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine REAL(DbKi), INTENT(IN) :: Default_DT !< The default DT (from glue code) - CHARACTER(*), INTENT(IN) :: InputFileName !< Name of the input file CHARACTER(*), INTENT(IN) :: OutFileRoot !< The rootname of all the output files written by this routine. TYPE(SrvD_InputFile), INTENT(OUT) :: InputFileData !< Data stored in the module's input file @@ -1650,7 +1763,7 @@ SUBROUTINE SrvD_ReadInput( InputFileName, InputFileData, Default_DT, OutFileRoot ! get the primary/platform input-file data - CALL ReadPrimaryFile( InputFileName, InputFileData, OutFileRoot, UnEcho, ErrStat2, ErrMsg2 ) + CALL ReadPrimaryFile( InitInp, InputFileData, OutFileRoot, UnEcho, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) IF ( ErrStat >= AbortErrLev ) THEN IF ( UnEcho > 0 ) CLOSE( UnEcho ) @@ -1671,20 +1784,20 @@ END SUBROUTINE SrvD_ReadInput !---------------------------------------------------------------------------------------------------------------------------------- !> This routine reads in the primary ServoDyn input file and places the values it reads in the InputFileData structure. !! It opens and prints to an echo file if requested. -SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, OutFileRoot, UnEc, ErrStat, ErrMsg ) +SUBROUTINE ReadPrimaryFile( InitInp, InputFileData, OutFileRoot, UnEc, ErrStat, ErrMsg ) !.................................................................................................................................. IMPLICIT NONE ! Passed variables - INTEGER(IntKi), INTENT(OUT) :: UnEc !< I/O unit for echo file. If > 0, file is open for writing. - INTEGER(IntKi), INTENT(OUT) :: ErrStat !< Error status + INTEGER(IntKi), INTENT(OUT) :: UnEc !< I/O unit for echo file. If > 0, file is open for writing. + INTEGER(IntKi), INTENT(OUT) :: ErrStat !< Error status - CHARACTER(*), INTENT(IN) :: InputFile !< Name of the file containing the primary input data - CHARACTER(*), INTENT(OUT) :: ErrMsg !< Error message - CHARACTER(*), INTENT(IN) :: OutFileRoot !< The rootname of the echo file, possibly opened in this routine + TYPE(SrvD_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine + CHARACTER(*), INTENT(OUT) :: ErrMsg !< Error message + CHARACTER(*), INTENT(IN) :: OutFileRoot !< The rootname of the echo file, possibly opened in this routine - TYPE(SrvD_InputFile), INTENT(INOUT) :: InputFileData !< All the data in the ServoDyn input file + TYPE(SrvD_InputFile), INTENT(INOUT) :: InputFileData !< All the data in the ServoDyn input file ! Local variables: REAL(ReKi) :: TmpRAry(2) ! A temporary array to read a table from the input file @@ -1701,14 +1814,13 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, OutFileRoot, UnEc, ErrStat - ! Initialize some variables: ErrStat = ErrID_None ErrMsg = "" UnEc = -1 Echo = .FALSE. - CALL GetPath( InputFile, PriPath ) ! Input files will be relative to the path where the primary input file is located. + CALL GetPath( InitInp%InputFile, PriPath ) ! Input files will be relative to the path where the primary input file is located. CALL AllocAry( InputFileData%OutList, MaxOutPts, "ServoDyn Input File's Outlist", ErrStat2, ErrMsg2 ) @@ -1725,7 +1837,7 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, OutFileRoot, UnEc, ErrStat ! Open the Primary input file. - CALL OpenFInpFile ( UnIn, InputFile, ErrStat2, ErrMsg2 ) + CALL OpenFInpFile ( UnIn, InitInp%InputFile, ErrStat2, ErrMsg2 ) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN @@ -1738,24 +1850,24 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, OutFileRoot, UnEc, ErrStat DO !-------------------------- HEADER --------------------------------------------- - CALL ReadCom( UnIn, InputFile, 'File header: Module Version (line 1)', ErrStat2, ErrMsg2, UnEc ) + CALL ReadCom( UnIn, InitInp%InputFile, 'File header: Module Version (line 1)', ErrStat2, ErrMsg2, UnEc ) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN - CALL ReadStr( UnIn, InputFile, FTitle, 'FTitle', 'File Header: File Description (line 2)', ErrStat2, ErrMsg2, UnEc ) + CALL ReadStr( UnIn, InitInp%InputFile, FTitle, 'FTitle', 'File Header: File Description (line 2)', ErrStat2, ErrMsg2, UnEc ) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN !---------------------- SIMULATION CONTROL -------------------------------------- - CALL ReadCom( UnIn, InputFile, 'Section Header: Simulation Control', ErrStat2, ErrMsg2, UnEc ) + CALL ReadCom( UnIn, InitInp%InputFile, 'Section Header: Simulation Control', ErrStat2, ErrMsg2, UnEc ) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! Echo - Echo input to ".ech". - CALL ReadVar( UnIn, InputFile, Echo, 'Echo', 'Echo switch', ErrStat2, ErrMsg2, UnEc ) + CALL ReadVar( UnIn, InitInp%InputFile, Echo, 'Echo', 'Echo switch', ErrStat2, ErrMsg2, UnEc ) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN @@ -1770,11 +1882,11 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, OutFileRoot, UnEc, ErrStat CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN - IF ( UnEc > 0 ) WRITE (UnEc,'(/,A,/)') 'Data from '//TRIM(SrvD_Ver%Name)//' primary input file "'//TRIM( InputFile )//'":' + IF ( UnEc > 0 ) WRITE (UnEc,'(/,A,/)') 'Data from '//TRIM(SrvD_Ver%Name)//' primary input file "'//TRIM( InitInp%InputFile )//'":' REWIND( UnIn, IOSTAT=ErrStat2 ) IF (ErrStat2 /= 0_IntKi ) THEN - CALL CheckError( ErrID_Fatal, 'Error rewinding file "'//TRIM(InputFile)//'".' ) + CALL CheckError( ErrID_Fatal, 'Error rewinding file "'//TRIM(InitInp%InputFile)//'".' ) RETURN END IF @@ -1787,427 +1899,430 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, OutFileRoot, UnEc, ErrStat ! DT - Communication interval for controllers (s): - CALL ReadVar( UnIn, InputFile, Line, "DT", "Communication interval for controllers (s)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, Line, "DT", "Communication interval for controllers (s)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN CALL Conv2UC( Line ) IF ( INDEX(Line, "DEFAULT" ) /= 1 ) THEN ! If it's not "default", read this variable; otherwise use the value already stored in InputFileData%DT READ( Line, *, IOSTAT=IOS) InputFileData%DT - CALL CheckIOS ( IOS, InputFile, 'DT', NumType, ErrStat2, ErrMsg2 ) + CALL CheckIOS ( IOS, InitInp%InputFile, 'DT', NumType, ErrStat2, ErrMsg2 ) CALL CheckError(ErrStat2, ErrMsg2) IF ( ErrStat >= AbortErrLev ) RETURN END IF !---------------------- PITCH CONTROL ------------------------------------------- - CALL ReadCom( UnIn, InputFile, 'Section Header: Pitch Control', ErrStat2, ErrMsg2, UnEc ) + CALL ReadCom( UnIn, InitInp%InputFile, 'Section Header: Pitch Control', ErrStat2, ErrMsg2, UnEc ) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! PCMode - Pitch control mode (-): - CALL ReadVar( UnIn, InputFile, InputFileData%PCMode, "PCMode", "Pitch control mode (-)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%PCMode, "PCMode", "Pitch control mode (-)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! TPCOn - Time to enable active pitch control [unused when PCMode=0] (s): - CALL ReadVar( UnIn, InputFile, InputFileData%TPCOn, "TPCOn", "Time to enable active pitch control (s)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%TPCOn, "TPCOn", "Time to enable active pitch control (s)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! TPitManS - Time to start override pitch maneuver for blade (K) and end standard pitch control (s): - CALL ReadAryLines( UnIn, InputFile, InputFileData%TPitManS, SIZE(InputFileData%TPitManS), "TPitManS", & + CALL ReadAryLines( UnIn, InitInp%InputFile, InputFileData%TPitManS, SIZE(InputFileData%TPitManS), "TPitManS", & "Time to start override pitch maneuver for blade K and end standard pitch control (s)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! PitManRat - Pitch rates at which override pitch maneuvers head toward final pitch angles (degrees/s) (read in deg/s and converted to radians/s here): - CALL ReadAryLines( UnIn, InputFile, InputFileData%PitManRat, SIZE(InputFileData%PitManRat), "PitManRat", "Pitch rates at which override pitch maneuvers head toward final pitch angles (deg/s)", ErrStat2, ErrMsg2, UnEc) + CALL ReadAryLines( UnIn, InitInp%InputFile, InputFileData%PitManRat, SIZE(InputFileData%PitManRat), "PitManRat", "Pitch rates at which override pitch maneuvers head toward final pitch angles (deg/s)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN InputFileData%PitManRat = InputFileData%PitManRat*D2R ! BlPitchF - Blade (K) final pitch for pitch maneuvers (deg) (read from file in degrees and converted to radians here): - CALL ReadAryLines( UnIn, InputFile, InputFileData%BlPitchF, SIZE(InputFileData%BlPitchF), "BlPitchF", "Blade K final pitch for pitch maneuvers (deg)", ErrStat2, ErrMsg2, UnEc) + CALL ReadAryLines( UnIn, InitInp%InputFile, InputFileData%BlPitchF, SIZE(InputFileData%BlPitchF), "BlPitchF", "Blade K final pitch for pitch maneuvers (deg)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN InputFileData%BlPitchF = InputFileData%BlPitchF*D2R + !---------------------- GENERATOR AND TORQUE CONTROL ---------------------------- - CALL ReadCom( UnIn, InputFile, 'Section Header: Generator and Torque Control', ErrStat2, ErrMsg2, UnEc ) + CALL ReadCom( UnIn, InitInp%InputFile, 'Section Header: Generator and Torque Control', ErrStat2, ErrMsg2, UnEc ) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! VSContrl - Variable-speed control mode {0: none, 1: simple VS, 3: user-defined from routine UserVSCont, 4: user-defined from Simulink/LabVIEW} (-): - CALL ReadVar( UnIn, InputFile, InputFileData%VSContrl, "VSContrl", "Variable-speed control mode (-)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%VSContrl, "VSContrl", "Variable-speed control mode (-)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! GenModel - Generator model {1: simple, 2: Thevenin, 3: user-defined from routine UserGen} [used only when VSContrl=0] (-): - CALL ReadVar( UnIn, InputFile, InputFileData%GenModel, "GenModel", "Generator model {1: simple, 2: Thevenin, 3: user-defined from routine UserGen} [used only when VSContrl=0] (-)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%GenModel, "GenModel", "Generator model {1: simple, 2: Thevenin, 3: user-defined from routine UserGen} [used only when VSContrl=0] (-)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! GenEff - Generator efficiency [ignored by the Thevenin and user-defined generator models] (%) (read in percent and converted to a fraction here): - CALL ReadVar( UnIn, InputFile, InputFileData%GenEff, "GenEff", "Generator efficiency [ignored by the Thevenin and user-defined generator models] (%)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%GenEff, "GenEff", "Generator efficiency [ignored by the Thevenin and user-defined generator models] (%)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN InputFileData%GenEff = InputFileData%GenEff*0.01 ! GenTiStr - Method to start the generator {T: timed using TimGenOn, F: generator speed using SpdGenOn} (flag): - CALL ReadVar( UnIn, InputFile, InputFileData%GenTiStr, "GenTiStr", "Method to start the generator {T: timed using TimGenOn, F: generator speed using SpdGenOn} (flag)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%GenTiStr, "GenTiStr", "Method to start the generator {T: timed using TimGenOn, F: generator speed using SpdGenOn} (flag)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! GenTiStp - Method to stop the generator {T: timed using TimGenOf, F: when generator power = 0} (flag): - CALL ReadVar( UnIn, InputFile, InputFileData%GenTiStp, "GenTiStp", "Method to stop the generator {T: timed using TimGenOf, F: when generator power = 0} (flag)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%GenTiStp, "GenTiStp", "Method to stop the generator {T: timed using TimGenOf, F: when generator power = 0} (flag)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! SpdGenOn - Generator speed to turn on the generator for a startup (HSS speed) [used only when GenTiStr=False] (rpm) (read in rpm and converted to rad/sec here): - CALL ReadVar( UnIn, InputFile, InputFileData%SpdGenOn, "SpdGenOn", "Generator speed to turn on the generator for a startup (HSS speed) [used only when GenTiStr=False] (rpm)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%SpdGenOn, "SpdGenOn", "Generator speed to turn on the generator for a startup (HSS speed) [used only when GenTiStr=False] (rpm)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN InputFileData%SpdGenOn = InputFileData%SpdGenOn*RPM2RPS ! TimGenOn - Time to turn on the generator for a startup [used only when GenTiStr=True] (s): - CALL ReadVar( UnIn, InputFile, InputFileData%TimGenOn, "TimGenOn", "Time to turn on the generator for a startup [used only when GenTiStr=True] (s)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%TimGenOn, "TimGenOn", "Time to turn on the generator for a startup [used only when GenTiStr=True] (s)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! TimGenOf - Time to turn off the generator [used only when GenTiStp=True] (s): - CALL ReadVar( UnIn, InputFile, InputFileData%TimGenOf, "TimGenOf", "Time to turn off the generator [used only when GenTiStp=True] (s)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%TimGenOf, "TimGenOf", "Time to turn off the generator [used only when GenTiStp=True] (s)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN !---------------------- SIMPLE VARIABLE-SPEED TORQUE CONTROL -------------------- - CALL ReadCom( UnIn, InputFile, 'Section Header: Simple Variable-Speed Torque Control', ErrStat2, ErrMsg2, UnEc ) + CALL ReadCom( UnIn, InitInp%InputFile, 'Section Header: Simple Variable-Speed Torque Control', ErrStat2, ErrMsg2, UnEc ) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! VS_RtGnSp - Rated generator speed for simple variable-speed generator control (HSS side) [used only when VSContrl=1] (rpm) (read in rpm and converted to rad/sec here): - CALL ReadVar( UnIn, InputFile, InputFileData%VS_RtGnSp, "VS_RtGnSp", "Rated generator speed for simple variable-speed generator control (HSS side) [used only when VSContrl=1] (rpm)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%VS_RtGnSp, "VS_RtGnSp", "Rated generator speed for simple variable-speed generator control (HSS side) [used only when VSContrl=1] (rpm)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN InputFileData%VS_RtGnSp = InputFileData%VS_RtGnSp*RPM2RPS ! VS_RtTq - Rated generator torque/constant generator torque in Region 3 for simple variable-speed generator control (HSS side) [used only when VSContrl=1] (N-m): - CALL ReadVar( UnIn, InputFile, InputFileData%VS_RtTq, "VS_RtTq", "Rated generator torque/constant generator torque in Region 3 for simple variable-speed generator control (HSS side) [used only when VSContrl=1] (N-m)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%VS_RtTq, "VS_RtTq", "Rated generator torque/constant generator torque in Region 3 for simple variable-speed generator control (HSS side) [used only when VSContrl=1] (N-m)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! VS_Rgn2K - Generator torque constant in Region 2 for simple variable-speed generator control (HSS side) [used only when VSContrl=1] (N-m/rpm^2) (read in N-m/rpm^2 and converted to N-m/(rad/s)^2 here: - CALL ReadVar( UnIn, InputFile, InputFileData%VS_Rgn2K, "VS_Rgn2K", "Generator torque constant in Region 2 for simple variable-speed generator control (HSS side) [used only when VSContrl=1] (N-m/rpm^2)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%VS_Rgn2K, "VS_Rgn2K", "Generator torque constant in Region 2 for simple variable-speed generator control (HSS side) [used only when VSContrl=1] (N-m/rpm^2)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN InputFileData%VS_Rgn2K = InputFileData%VS_Rgn2K/( RPM2RPS**2 ) ! VS_SlPc - Rated generator slip percentage in Region 2 1/2 for simple variable-speed generator control [used only when VSContrl=1] (%) (read in percent and converted to a fraction here): - CALL ReadVar( UnIn, InputFile, InputFileData%VS_SlPc, "VS_SlPc", "Rated generator slip percentage in Region 2 1/2 for simple variable-speed generator control [used only when VSContrl=1] (%)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%VS_SlPc, "VS_SlPc", "Rated generator slip percentage in Region 2 1/2 for simple variable-speed generator control [used only when VSContrl=1] (%)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN InputFileData%VS_SlPc = InputFileData%VS_SlPc*.01 !---------------------- SIMPLE INDUCTION GENERATOR ------------------------------ - CALL ReadCom( UnIn, InputFile, 'Section Header: Simple Induction Generator', ErrStat2, ErrMsg2, UnEc ) + CALL ReadCom( UnIn, InitInp%InputFile, 'Section Header: Simple Induction Generator', ErrStat2, ErrMsg2, UnEc ) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! SIG_SlPc - Rated generator slip percentage [used only when VSContrl=0 and GenModel=1] (%) (read in percent and converted to a fraction here): - CALL ReadVar( UnIn, InputFile, InputFileData%SIG_SlPc, "SIG_SlPc", "Rated generator slip percentage [used only when VSContrl=0 and GenModel=1] (%)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%SIG_SlPc, "SIG_SlPc", "Rated generator slip percentage [used only when VSContrl=0 and GenModel=1] (%)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN InputFileData%SIG_SlPc = InputFileData%SIG_SlPc*.01 ! SIG_SySp - Synchronous (zero-torque) generator speed [used only when VSContrl=0 and GenModel=1] (rpm) (read in rpm and convert to rad/sec here): - CALL ReadVar( UnIn, InputFile, InputFileData%SIG_SySp, "SIG_SySp", "Synchronous (zero-torque) generator speed [used only when VSContrl=0 and GenModel=1] (rpm)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%SIG_SySp, "SIG_SySp", "Synchronous (zero-torque) generator speed [used only when VSContrl=0 and GenModel=1] (rpm)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN InputFileData%SIG_SySp = InputFileData%SIG_SySp*RPM2RPS ! SIG_RtTq - Rated torque [used only when VSContrl=0 and GenModel=1] (N-m): - CALL ReadVar( UnIn, InputFile, InputFileData%SIG_RtTq, "SIG_RtTq", "Rated torque [used only when VSContrl=0 and GenModel=1] (N-m)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%SIG_RtTq, "SIG_RtTq", "Rated torque [used only when VSContrl=0 and GenModel=1] (N-m)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! SIG_PORt - Pull-out ratio (Tpullout/Trated) [used only when VSContrl=0 and GenModel=1] (-): - CALL ReadVar( UnIn, InputFile, InputFileData%SIG_PORt, "SIG_PORt", "Pull-out ratio (Tpullout/Trated) [used only when VSContrl=0 and GenModel=1] (-)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%SIG_PORt, "SIG_PORt", "Pull-out ratio (Tpullout/Trated) [used only when VSContrl=0 and GenModel=1] (-)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN !---------------------- THEVENIN-EQUIVALENT INDUCTION GENERATOR ----------------- - CALL ReadCom( UnIn, InputFile, 'Section Header: Thevenin-Equivalent Induction Generator', ErrStat2, ErrMsg2, UnEc ) + CALL ReadCom( UnIn, InitInp%InputFile, 'Section Header: Thevenin-Equivalent Induction Generator', ErrStat2, ErrMsg2, UnEc ) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! TEC_Freq - Line frequency [50 or 60] [used only when VSContrl=0 and GenModel=2] (Hz): - CALL ReadVar( UnIn, InputFile, InputFileData%TEC_Freq, "TEC_Freq", "Line frequency [50 or 60] [used only when VSContrl=0 and GenModel=2] (Hz)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%TEC_Freq, "TEC_Freq", "Line frequency [50 or 60] [used only when VSContrl=0 and GenModel=2] (Hz)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! TEC_NPol - Number of poles [even integer > 0] [used only when VSContrl=0 and GenModel=2] (-): - CALL ReadVar( UnIn, InputFile, InputFileData%TEC_NPol, "TEC_NPol", "Number of poles [even integer > 0] [used only when VSContrl=0 and GenModel=2] (-)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%TEC_NPol, "TEC_NPol", "Number of poles [even integer > 0] [used only when VSContrl=0 and GenModel=2] (-)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! TEC_SRes - Stator resistance [used only when VSContrl=0 and GenModel=2] (ohms): - CALL ReadVar( UnIn, InputFile, InputFileData%TEC_SRes, "TEC_SRes", "Stator resistance [used only when VSContrl=0 and GenModel=2] (ohms)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%TEC_SRes, "TEC_SRes", "Stator resistance [used only when VSContrl=0 and GenModel=2] (ohms)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! TEC_RRes - Rotor resistance [used only when VSContrl=0 and GenModel=2] (ohms): - CALL ReadVar( UnIn, InputFile, InputFileData%TEC_RRes, "TEC_RRes", "Rotor resistance [used only when VSContrl=0 and GenModel=2] (ohms)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%TEC_RRes, "TEC_RRes", "Rotor resistance [used only when VSContrl=0 and GenModel=2] (ohms)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! TEC_VLL - Line-to-line RMS voltage [used only when VSContrl=0 and GenModel=2] (volts): - CALL ReadVar( UnIn, InputFile, InputFileData%TEC_VLL, "TEC_VLL", "Line-to-line RMS voltage [used only when VSContrl=0 and GenModel=2] (volts)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%TEC_VLL, "TEC_VLL", "Line-to-line RMS voltage [used only when VSContrl=0 and GenModel=2] (volts)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! TEC_SLR - Stator leakage reactance [used only when VSContrl=0 and GenModel=2] (ohms): - CALL ReadVar( UnIn, InputFile, InputFileData%TEC_SLR, "TEC_SLR", "Stator leakage reactance [used only when VSContrl=0 and GenModel=2] (ohms)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%TEC_SLR, "TEC_SLR", "Stator leakage reactance [used only when VSContrl=0 and GenModel=2] (ohms)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! TEC_RLR - Rotor leakage reactance [used only when VSContrl=0 and GenModel=2] (ohms): - CALL ReadVar( UnIn, InputFile, InputFileData%TEC_RLR, "TEC_RLR", "Rotor leakage reactance [used only when VSContrl=0 and GenModel=2] (ohms)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%TEC_RLR, "TEC_RLR", "Rotor leakage reactance [used only when VSContrl=0 and GenModel=2] (ohms)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! TEC_MR - Magnetizing reactance [used only when VSContrl=0 and GenModel=2] (ohms): - CALL ReadVar( UnIn, InputFile, InputFileData%TEC_MR, "TEC_MR", "Magnetizing reactance [used only when VSContrl=0 and GenModel=2] (ohms)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%TEC_MR, "TEC_MR", "Magnetizing reactance [used only when VSContrl=0 and GenModel=2] (ohms)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN !---------------------- HIGH-SPEED SHAFT BRAKE ---------------------------------- - CALL ReadCom( UnIn, InputFile, 'Section Header: High-Speed Shaft Brake', ErrStat2, ErrMsg2, UnEc ) + CALL ReadCom( UnIn, InitInp%InputFile, 'Section Header: High-Speed Shaft Brake', ErrStat2, ErrMsg2, UnEc ) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN - ! HSSBrMode - HSS brake model {0: none, 1: simple, 3: user-defined from routine UserHSSBr, 4: user-defined from LabVIEW, 5: user-defined from Bladed-style DLL} (-): - CALL ReadVar( UnIn, InputFile, InputFileData%HSSBrMode, "HSSBrMode", "HSS brake model {0: none, 1: simple, 3: user-defined from routine UserHSSBr, 4: user-defined from LabVIEW} (-)", ErrStat2, ErrMsg2, UnEc) + ! HSSBrMode - HSS brake model {0: none, 1: simple, 3: user-defined from routine UserHSSBr, 4: user-defined from LabVIEW} (-): + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%HSSBrMode, "HSSBrMode", "HSS brake model {0: none, 1: simple, 3: user-defined from routine UserHSSBr, 4: user-defined from LabVIEW} (-)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! THSSBrDp - Time to initiate deployment of the HSS brake (s): - CALL ReadVar( UnIn, InputFile, InputFileData%THSSBrDp, "THSSBrDp", "Time to initiate deployment of the HSS brake (s)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%THSSBrDp, "THSSBrDp", "Time to initiate deployment of the HSS brake (s)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! HSSBrDT - Time for HSS-brake to reach full deployment once initiated [used only when HSSBrMode=1] (sec): - CALL ReadVar( UnIn, InputFile, InputFileData%HSSBrDT, "HSSBrDT", "Time for HSS-brake to reach full deployment once initiated [used only when HSSBrMode=1] (sec)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%HSSBrDT, "HSSBrDT", "Time for HSS-brake to reach full deployment once initiated [used only when HSSBrMode=1] (sec)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! HSSBrTqF - Fully deployed HSS-brake torque (N-m): - CALL ReadVar( UnIn, InputFile, InputFileData%HSSBrTqF, "HSSBrTqF", "Fully deployed HSS-brake torque (N-m)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%HSSBrTqF, "HSSBrTqF", "Fully deployed HSS-brake torque (N-m)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN !---------------------- YAW CONTROL --------------------------------------------- - CALL ReadCom( UnIn, InputFile, 'Section Header: Yaw Control', ErrStat2, ErrMsg2, UnEc ) + CALL ReadCom( UnIn, InitInp%InputFile, 'Section Header: Yaw Control', ErrStat2, ErrMsg2, UnEc ) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! YCMode - Yaw control mode {0: none, 3: user-defined from routine UserYawCont, 4: user-defined from Simulink/LabVIEW} (-): - CALL ReadVar( UnIn, InputFile, InputFileData%YCMode, "YCMode", "Yaw control mode (-)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%YCMode, "YCMode", "Yaw control mode (-)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! TYCOn - Time to enable active yaw control [unused when YCMode=0] (s): - CALL ReadVar( UnIn, InputFile, InputFileData%TYCOn, "TYCOn", "Time to enable active yaw control [unused when YCMode=0] (s)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%TYCOn, "TYCOn", "Time to enable active yaw control [unused when YCMode=0] (s)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! YawNeut - Neutral yaw position--yaw spring force is zero at this yaw (deg) (read from file in degrees and converted to radians here): - CALL ReadVar( UnIn, InputFile, InputFileData%YawNeut, "YawNeut", "Neutral yaw position--yaw spring force is zero at this yaw (deg)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%YawNeut, "YawNeut", "Neutral yaw position--yaw spring force is zero at this yaw (deg)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN InputFileData%YawNeut = InputFileData%YawNeut*D2R ! YawSpr - Nacelle-yaw spring constant (N-m/rad): - CALL ReadVar( UnIn, InputFile, InputFileData%YawSpr, "YawSpr", "Nacelle-yaw spring constant (N-m/rad)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%YawSpr, "YawSpr", "Nacelle-yaw spring constant (N-m/rad)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! YawDamp - Nacelle-yaw constant (N-m/(rad/s)): - CALL ReadVar( UnIn, InputFile, InputFileData%YawDamp, "YawDamp", "Nacelle-yaw constant (N-m/(rad/s))", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%YawDamp, "YawDamp", "Nacelle-yaw constant (N-m/(rad/s))", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! TYawManS - Time to start override yaw maneuver and end standard yaw control (s): - CALL ReadVar( UnIn, InputFile, InputFileData%TYawManS, "TYawManS", "Time to start override yaw maneuver and end standard yaw control (s)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%TYawManS, "TYawManS", "Time to start override yaw maneuver and end standard yaw control (s)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! YawManRat - Yaw maneuver rate (in absolute value) (deg/s) (read in degrees/second and converted to radians/second here): - CALL ReadVar( UnIn, InputFile, InputFileData%YawManRat, "YawManRat", "Yaw maneuver rate (in absolute value) (deg/s)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%YawManRat, "YawManRat", "Yaw maneuver rate (in absolute value) (deg/s)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN InputFileData%YawManRat = InputFileData%YawManRat*D2R ! NacYawF - Final yaw angle for override yaw maneuvers (deg) (read from file in degrees and converted to radians here): - CALL ReadVar( UnIn, InputFile, InputFileData%NacYawF, "NacYawF", "Final yaw angle for override yaw maneuvers (deg)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%NacYawF, "NacYawF", "Final yaw angle for override yaw maneuvers (deg)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN InputFileData%NacYawF = InputFileData%NacYawF*D2R !---------------------- TUNED MASS DAMPER ---------------------------------------- - CALL ReadCom( UnIn, InputFile, 'Section Header: Tuned Mass Damper', ErrStat2, ErrMsg2, UnEc ) + CALL ReadCom( UnIn, InitInp%InputFile, 'Section Header: Tuned Mass Damper', ErrStat2, ErrMsg2, UnEc ) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! CompNTMD - Compute nacelle tuned mass damper {true/false} (flag): - CALL ReadVar( UnIn, InputFile, InputFileData%CompNTMD, "CompNTMD", "Compute nacelle tuned mass damper {true/false} (flag)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%CompNTMD, "CompNTMD", "Compute nacelle tuned mass damper {true/false} (flag)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! NTMDfile - Name of the file for nacelle tuned mass damper (quoted string) [unused when CompNTMD is false]: - CALL ReadVar( UnIn, InputFile, InputFileData%NTMDfile, "NTMDfile", "Name of the file for nacelle tuned mass dampe [unused when CompNTMD is false] (-)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%NTMDfile, "NTMDfile", "Name of the file for nacelle tuned mass dampe [unused when CompNTMD is false] (-)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN IF ( PathIsRelative( InputFileData%NTMDfile ) ) InputFileData%NTMDfile = TRIM(PriPath)//TRIM(InputFileData%NTMDfile) ! CompTTMD - Compute tower tuned mass damper {true/false} (flag): - CALL ReadVar( UnIn, InputFile, InputFileData%CompTTMD, "CompTTMD", "Compute tower tuned mass damper {true/false} (flag)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%CompTTMD, "CompTTMD", "Compute tower tuned mass damper {true/false} (flag)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! TTMDfile - Name of the file for nacelle tuned mass damper (quoted string) [unused when CompNTMD is false]: - CALL ReadVar( UnIn, InputFile, InputFileData%TTMDfile, "TTMDfile", "Name of the file for tower tuned mass dampe [unused when CompTTMD is false] (-)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%TTMDfile, "TTMDfile", "Name of the file for tower tuned mass dampe [unused when CompTTMD is false] (-)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN IF ( PathIsRelative( InputFileData%TTMDfile ) ) InputFileData%TTMDfile = TRIM(PriPath)//TRIM(InputFileData%TTMDfile) !---------------------- BLADED INTERFACE ---------------------------------------- - CALL ReadCom( UnIn, InputFile, 'Section Header: Bladed Interface', ErrStat2, ErrMsg2, UnEc ) + CALL ReadCom( UnIn, InitInp%InputFile, 'Section Header: Bladed Interface', ErrStat2, ErrMsg2, UnEc ) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN + InputFileData%UseLegacyInterface = .true. + ! DLL_FileName - Name of the Bladed DLL [used only with DLL Interface] (-): - CALL ReadVar( UnIn, InputFile, InputFileData%DLL_FileName, "DLL_FileName", "Name/location of the external library {.dll [Windows]} in the Bladed-DLL format [used only with DLL Interface] (-)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%DLL_FileName, "DLL_FileName", "Name/location of the external library {.dll [Windows]} in the Bladed-DLL format [used only with DLL Interface] (-)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN IF ( PathIsRelative( InputFileData%DLL_FileName ) ) InputFileData%DLL_FileName = TRIM(PriPath)//TRIM(InputFileData%DLL_FileName) ! DLL_InFile - Name of input file used in DLL [used only with DLL Interface] (-): - CALL ReadVar( UnIn, InputFile, InputFileData%DLL_InFile, "DLL_InFile", "Name of input file used in DLL [used only with DLL Interface] (-)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%DLL_InFile, "DLL_InFile", "Name of input file used in DLL [used only with DLL Interface] (-)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN IF ( PathIsRelative( InputFileData%DLL_InFile ) ) InputFileData%DLL_InFile = TRIM(PriPath)//TRIM(InputFileData%DLL_InFile) ! DLL_ProcName - Name of procedure to be called in DLL [used only with DLL Interface] (-): - CALL ReadVar( UnIn, InputFile, InputFileData%DLL_ProcName, "DLL_ProcName", "Name of procedure to be called in DLL [used only with DLL Interface] (-)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%DLL_ProcName, "DLL_ProcName", "Name of procedure to be called in DLL [used only with DLL Interface] (-)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! DLL_DT - Communication interval for dynamic library (s): InputFileData%DLL_DT = InputFileData%DT - CALL ReadVar( UnIn, InputFile, Line, "DLL_DT", "Communication interval for dynamic library (s)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, Line, "DLL_DT", "Communication interval for dynamic library (s)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN CALL Conv2UC( Line ) IF ( INDEX(Line, "DEFAULT" ) /= 1 ) THEN ! If it's not "default", read this variable; otherwise use the value already stored in InputFileData%DLL_DT READ( Line, *, IOSTAT=IOS) InputFileData%DLL_DT - CALL CheckIOS ( IOS, InputFile, 'DLL_DT', NumType, ErrStat2, ErrMsg2 ) + CALL CheckIOS ( IOS, InitInp%InputFile, 'DLL_DT', NumType, ErrStat2, ErrMsg2 ) CALL CheckError(ErrStat2, ErrMsg2) IF ( ErrStat >= AbortErrLev ) RETURN END IF ! DLL_Ramp - Whether a linear ramp should be used between DLL_DT time steps [introduces time shift when true] (flag): - CALL ReadVar( UnIn, InputFile, InputFileData%DLL_Ramp, "DLL_Ramp", "Whether a linear ramp should be used between DLL_DT time steps [introduces time shift when true]", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%DLL_Ramp, "DLL_Ramp", "Whether a linear ramp should be used between DLL_DT time steps [introduces time shift when true]", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! BPCutoff - Cuttoff frequency for low-pass filter on blade pitch (Hz): - CALL ReadVar( UnIn, InputFile, InputFileData%BPCutoff, "BPCutoff", "Cuttoff frequency for low-pass filter on blade pitch (Hz)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%BPCutoff, "BPCutoff", "Cuttoff frequency for low-pass filter on blade pitch (Hz)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! NacYaw_North - Reference yaw angle of the nacelle when the upwind end points due North (deg) (read from file in degrees and converted to radians here): - CALL ReadVar( UnIn, InputFile, InputFileData%NacYaw_North, "NacYaw_North", "Reference yaw angle of the nacelle when the upwind end points due North (deg)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%NacYaw_North, "NacYaw_North", "Reference yaw angle of the nacelle when the upwind end points due North (deg)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN InputFileData%NacYaw_North = InputFileData%NacYaw_North*D2R ! Ptch_Cntrl - Record 28: Use individual pitch control {0: collective pitch; 1: individual pitch control} [used only with DLL Interface] (-): - CALL ReadVar( UnIn, InputFile, InputFileData%Ptch_Cntrl, "Ptch_Cntrl", "Record 28: Use individual pitch control {0: collective pitch; 1: individual pitch control} [used only with DLL Interface] (-)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%Ptch_Cntrl, "Ptch_Cntrl", "Record 28: Use individual pitch control {0: collective pitch; 1: individual pitch control} [used only with DLL Interface] (-)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! Ptch_SetPnt - Record 5: Below-rated pitch angle set-point [used only with DLL Interface] (deg) (read from file in degrees and converted to radians here): - CALL ReadVar( UnIn, InputFile, InputFileData%Ptch_SetPnt, "Ptch_SetPnt", "Record 5: Below-rated pitch angle set-point [used only with DLL Interface] (deg)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%Ptch_SetPnt, "Ptch_SetPnt", "Record 5: Below-rated pitch angle set-point [used only with DLL Interface] (deg)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN InputFileData%Ptch_SetPnt = InputFileData%Ptch_SetPnt*D2R ! Ptch_Min - Record 6: Minimum pitch angle [used only with DLL Interface] (deg) (read from file in degrees and converted to radians here): - CALL ReadVar( UnIn, InputFile, InputFileData%Ptch_Min, "Ptch_Min", "Record 6: Minimum pitch angle [used only with DLL Interface] (deg)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%Ptch_Min, "Ptch_Min", "Record 6: Minimum pitch angle [used only with DLL Interface] (deg)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN InputFileData%Ptch_Min = InputFileData%Ptch_Min*D2R ! Ptch_Max - Record 7: Maximum pitch angle [used only with DLL Interface] (deg) (read from file in degrees and converted to radians here): - CALL ReadVar( UnIn, InputFile, InputFileData%Ptch_Max, "Ptch_Max", "Record 7: Maximum pitch angle [used only with DLL Interface] (deg)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%Ptch_Max, "Ptch_Max", "Record 7: Maximum pitch angle [used only with DLL Interface] (deg)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN InputFileData%Ptch_Max = InputFileData%Ptch_Max*D2R ! PtchRate_Min - Record 8: Minimum pitch rate (most negative value allowed) [used only with DLL Interface] (deg/s) (read from file in deg/s and converted to rad/s here): - CALL ReadVar( UnIn, InputFile, InputFileData%PtchRate_Min, "PtchRate_Min", "Record 8: Minimum pitch rate (most negative value allowed) [used only with DLL Interface] (deg/s)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%PtchRate_Min, "PtchRate_Min", "Record 8: Minimum pitch rate (most negative value allowed) [used only with DLL Interface] (deg/s)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN InputFileData%PtchRate_Min = InputFileData%PtchRate_Min*D2R ! PtchRate_Max - Record 9: Maximum pitch rate [used only with DLL Interface] (deg/s) (read from file in deg/s and converted to rad/s here): - CALL ReadVar( UnIn, InputFile, InputFileData%PtchRate_Max, "PtchRate_Max", "Record 9: Maximum pitch rate [used only with DLL Interface] (deg/s)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%PtchRate_Max, "PtchRate_Max", "Record 9: Maximum pitch rate [used only with DLL Interface] (deg/s)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN InputFileData%PtchRate_Max = InputFileData%PtchRate_Max*D2R ! Gain_OM - Record 16: Optimal mode gain [used only with DLL Interface] (Nm/(rad/s)^2): - CALL ReadVar( UnIn, InputFile, InputFileData%Gain_OM, "Gain_OM", "Record 16: Optimal mode gain [used only with DLL Interface] (Nm/(rad/s)^2)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%Gain_OM, "Gain_OM", "Record 16: Optimal mode gain [used only with DLL Interface] (Nm/(rad/s)^2)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! GenSpd_MinOM - Record 17: Minimum generator speed [used only with DLL Interface] (rpm) (read from file in rpm and converted to rad/s here): - CALL ReadVar( UnIn, InputFile, InputFileData%GenSpd_MinOM, "GenSpd_MinOM", "Record 17: Minimum generator speed [used only with DLL Interface] (rpm)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%GenSpd_MinOM, "GenSpd_MinOM", "Record 17: Minimum generator speed [used only with DLL Interface] (rpm)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN InputFileData%GenSpd_MinOM = InputFileData%GenSpd_MinOM*RPM2RPS ! GenSpd_MaxOM - Record 18: Optimal mode maximum speed [used only with DLL Interface] (rpm) (read from file in rpm and converted to rad/s here): - CALL ReadVar( UnIn, InputFile, InputFileData%GenSpd_MaxOM, "GenSpd_MaxOM", "Record 18: Optimal mode maximum speed [used only with DLL Interface] (rpm)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%GenSpd_MaxOM, "GenSpd_MaxOM", "Record 18: Optimal mode maximum speed [used only with DLL Interface] (rpm)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN InputFileData%GenSpd_MaxOM = InputFileData%GenSpd_MaxOM*RPM2RPS ! GenSpd_Dem - Record 19: Demanded generator speed above rated [used only with DLL Interface] (rpm) (read from file in rpm and converted to rad/s here): - CALL ReadVar( UnIn, InputFile, InputFileData%GenSpd_Dem, "GenSpd_Dem", "Record 19: Demanded generator speed above rated [used only with DLL Interface] (rpm)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%GenSpd_Dem, "GenSpd_Dem", "Record 19: Demanded generator speed above rated [used only with DLL Interface] (rpm)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN InputFileData%GenSpd_Dem = InputFileData%GenSpd_Dem*RPM2RPS ! GenTrq_Dem - Record 22: Demanded generator torque above rated [used only with DLL Interface] (Nm): - CALL ReadVar( UnIn, InputFile, InputFileData%GenTrq_Dem, "GenTrq_Dem", "Record 22: Demanded generator torque above rated [used only with DLL Interface] (Nm)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%GenTrq_Dem, "GenTrq_Dem", "Record 22: Demanded generator torque above rated [used only with DLL Interface] (Nm)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! GenPwr_Dem - Record 13: Demanded power [used only with DLL Interface] (W): - CALL ReadVar( UnIn, InputFile, InputFileData%GenPwr_Dem, "GenPwr_Dem", "Record 13: Demanded power [used only with DLL Interface] (W)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%GenPwr_Dem, "GenPwr_Dem", "Record 13: Demanded power [used only with DLL Interface] (W)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN !---------------------- BLADED INTERFACE TORQUE-SPEED LOOK-UP TABLE ------------- - CALL ReadCom( UnIn, InputFile, 'Section Header: Bladed Interface Torque-Speed Look-Up Table', ErrStat2, ErrMsg2, UnEc ) + CALL ReadCom( UnIn, InitInp%InputFile, 'Section Header: Bladed Interface Torque-Speed Look-Up Table', ErrStat2, ErrMsg2, UnEc ) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! DLL_NumTrq - Record 26: No. of points in torque-speed look-up table {0 = none and use the optimal mode PARAMETERs instead, nonzero = ignore the optimal mode PARAMETERs by setting Gain_OM (Record 16) to 0.0} (-): - CALL ReadVar( UnIn, InputFile, InputFileData%DLL_NumTrq, "DLL_NumTrq", "Record 26: No. of points in torque-speed look-up table {0 = none and use the optimal mode PARAMETERs instead, nonzero = ignore the optimal mode PARAMETERs by setting Gain_OM (Record 16) to 0.0} (-)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%DLL_NumTrq, "DLL_NumTrq", "Record 26: No. of points in torque-speed look-up table {0 = none and use the optimal mode PARAMETERs instead, nonzero = ignore the optimal mode PARAMETERs by setting Gain_OM (Record 16) to 0.0} (-)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN @@ -2221,17 +2336,17 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, OutFileRoot, UnEc, ErrStat IF ( ErrStat >= AbortErrLev ) RETURN END IF - CALL ReadCom( UnIn, InputFile, 'Table Header: Bladed Interface Torque-Speed Look-Up Table', ErrStat2, ErrMsg2, UnEc ) + CALL ReadCom( UnIn, InitInp%InputFile, 'Table Header: Bladed Interface Torque-Speed Look-Up Table', ErrStat2, ErrMsg2, UnEc ) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN - CALL ReadCom( UnIn, InputFile, 'Table Units: Bladed Interface Torque-Speed Look-Up Table', ErrStat2, ErrMsg2, UnEc ) + CALL ReadCom( UnIn, InitInp%InputFile, 'Table Units: Bladed Interface Torque-Speed Look-Up Table', ErrStat2, ErrMsg2, UnEc ) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN DO I=1,InputFileData%DLL_NumTrq - CALL ReadAry( UnIn, InputFile, TmpRAry, 2_IntKi, 'Line'//TRIM(Num2LStr(I)), 'Bladed Interface Torque-Speed Look-Up Table', & + CALL ReadAry( UnIn, InitInp%InputFile, TmpRAry, 2_IntKi, 'Line'//TRIM(Num2LStr(I)), 'Bladed Interface Torque-Speed Look-Up Table', & ErrStat2, ErrMsg2, UnEc ) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN @@ -2243,52 +2358,52 @@ SUBROUTINE ReadPrimaryFile( InputFile, InputFileData, OutFileRoot, UnEc, ErrStat !---------------------- OUTPUT -------------------------------------------------- - CALL ReadCom( UnIn, InputFile, 'Section Header: Output', ErrStat2, ErrMsg2, UnEc ) + CALL ReadCom( UnIn, InitInp%InputFile, 'Section Header: Output', ErrStat2, ErrMsg2, UnEc ) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! SumPrint - Print summary data to .sum (flag): - CALL ReadVar( UnIn, InputFile, InputFileData%SumPrint, "SumPrint", "Print summary data to .sum (flag)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%SumPrint, "SumPrint", "Print summary data to .sum (flag)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! OutFile - Switch to determine where output will be placed: (1: in module output file only; 2: in glue code output file only; 3: both) (-): - CALL ReadVar( UnIn, InputFile, InputFileData%OutFile, "OutFile", "Switch to determine where output will be placed: {1: in module output file only; 2: in glue code output file only; 3: both} (-)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%OutFile, "OutFile", "Switch to determine where output will be placed: {1: in module output file only; 2: in glue code output file only; 3: both} (-)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! ! OutFileFmt - Format for module tabular (time-marching) output: (1: text file [.out], 2: binary file [.outb], 3: both): - !CALL ReadVar( UnIn, InputFile, InputFileData%OutFileFmt, "OutFileFmt", "Format for module tabular (time-marching) output: (1: text file [.out], 2: binary file [.outb], 3: both)", ErrStat2, ErrMsg2, UnEc) + !CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%OutFileFmt, "OutFileFmt", "Format for module tabular (time-marching) output: (1: text file [.out], 2: binary file [.outb], 3: both)", ErrStat2, ErrMsg2, UnEc) ! CALL CheckError( ErrStat2, ErrMsg2 ) ! IF ( ErrStat >= AbortErrLev ) RETURN ! TabDelim - Flag to cause tab-delimited text output (delimited by space otherwise) (flag): - CALL ReadVar( UnIn, InputFile, InputFileData%TabDelim, "TabDelim", "Flag to cause tab-delimited text output (delimited by space otherwise) (flag)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%TabDelim, "TabDelim", "Flag to cause tab-delimited text output (delimited by space otherwise) (flag)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! OutFmt - Format used for module's text tabult output (except time); resulting field should be 10 characters (-): - CALL ReadVar( UnIn, InputFile, InputFileData%OutFmt, "OutFmt", "Format used for module's text tabular output (except time); resulting field should be 10 characters (-)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%OutFmt, "OutFmt", "Format used for module's text tabular output (except time); resulting field should be 10 characters (-)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! Tstart - Time to start module's tabular output (seconds): - CALL ReadVar( UnIn, InputFile, InputFileData%Tstart, "Tstart", "Time to start module's tabular output (seconds)", ErrStat2, ErrMsg2, UnEc) + CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%Tstart, "Tstart", "Time to start module's tabular output (seconds)", ErrStat2, ErrMsg2, UnEc) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! ! ! DecFact - Decimation factor for module's tabular output (1=output every step) (-): - !CALL ReadVar( UnIn, InputFile, InputFileData%DecFact, "DecFact", "Decimation factor for module's tabular output (1=output every step) (-)", ErrStat2, ErrMsg2, UnEc) + !CALL ReadVar( UnIn, InitInp%InputFile, InputFileData%DecFact, "DecFact", "Decimation factor for module's tabular output (1=output every step) (-)", ErrStat2, ErrMsg2, UnEc) ! CALL CheckError( ErrStat2, ErrMsg2 ) ! IF ( ErrStat >= AbortErrLev ) RETURN !---------------------- OUTLIST -------------------------------------------- - CALL ReadCom( UnIn, InputFile, 'Section Header: OutList', ErrStat2, ErrMsg2, UnEc ) + CALL ReadCom( UnIn, InitInp%InputFile, 'Section Header: OutList', ErrStat2, ErrMsg2, UnEc ) CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN ! OutList - List of user-requested output channels (-): - CALL ReadOutputList ( UnIn, InputFile, InputFileData%OutList, InputFileData%NumOuts, 'OutList', "List of user-requested output channels", ErrStat2, ErrMsg2, UnEc ) ! Routine in NWTC Subroutine Library + CALL ReadOutputList ( UnIn, InitInp%InputFile, InputFileData%OutList, InputFileData%NumOuts, 'OutList', "List of user-requested output channels", ErrStat2, ErrMsg2, UnEc ) ! Routine in NWTC Subroutine Library CALL CheckError( ErrStat2, ErrMsg2 ) IF ( ErrStat >= AbortErrLev ) RETURN @@ -2333,22 +2448,26 @@ END SUBROUTINE CheckError END SUBROUTINE ReadPrimaryFile !---------------------------------------------------------------------------------------------------------------------------------- !> This routine validates the inputs from the primary input file. -SUBROUTINE ValidatePrimaryData( InitInp, InputFileData, NumBl, ErrStat, ErrMsg ) +SUBROUTINE ValidatePrimaryData( InitInp, InputFileData, ErrStat, ErrMsg ) !.................................................................................................................................. ! Passed variables: TYPE(SrvD_InitInputType), INTENT(IN ) :: InitInp !< Input data for initialization routine TYPE(SrvD_InputFile), INTENT(IN) :: InputFileData !< All the data in the ServoDyn input file - INTEGER(IntKi), INTENT(IN) :: NumBl !< Number of blades INTEGER(IntKi), INTENT(OUT) :: ErrStat !< Error status CHARACTER(*), INTENT(OUT) :: ErrMsg !< Error message ! local variables - INTEGER(IntKi) :: K ! Blade number + INTEGER(IntKi) :: K ! Blade number CHARACTER(*), PARAMETER :: RoutineName = 'ValidatePrimaryData' + INTEGER(IntKi) :: ErrStat2 !< Error status + CHARACTER(ErrMsgLen) :: ErrMsg2 !< temporary Error message if ErrStat /= ErrID_None + + ErrStat = ErrID_None + ErrMsg = '' CALL Pitch_ValidateData() CALL Yaw_ValidateData() @@ -2379,6 +2498,14 @@ SUBROUTINE ValidatePrimaryData( InitInp, InputFileData, NumBl, ErrStat, ErrMsg ) if (InputFileData%CompNTMD .or. InputFileData%CompTTMD) & call SetErrStat(ErrID_Fatal,"TMD module is not currently allowed in linearization. CompNTMD and CompTTMD must be FALSE.",ErrStat,ErrMsg,RoutineName) + if (InitInp%TrimCase /= TrimCase_none) then + if (InitInp%TrimCase /= TrimCase_yaw .and. InitInp%TrimCase /= TrimCase_torque .and. InitInp%TrimCase /= TrimCase_pitch) then + call SetErrStat(ErrID_Fatal,"Invalid value entered for TrimCase.",ErrStat,ErrMsg,RoutineName) + else + if (InitInp%TrimGain <= 0.0_ReKi) call SetErrStat(ErrID_Fatal,"TrimGain must be a positive number.",ErrStat,ErrMsg,RoutineName) + end if + end if + end if @@ -2424,11 +2551,11 @@ SUBROUTINE Pitch_ValidateData( ) ! Make sure the number of blades in the simulation doesn't exceed 3: - IF ( NumBl > SIZE(InputFileData%TPitManS,1) ) CALL SetErrStat( ErrID_Fatal, 'Number of blades exceeds input values.', ErrStat, ErrMsg, RoutineName ) + IF ( InitInp%NumBl > SIZE(InputFileData%TPitManS,1) ) CALL SetErrStat( ErrID_Fatal, 'Number of blades exceeds input values.', ErrStat, ErrMsg, RoutineName ) ! Check the pitch-maneuver start times and rates: - DO K=1,MIN(NumBl,SIZE(InputFileData%TPitManS)) + DO K=1,MIN(InitInp%NumBl,SIZE(InputFileData%TPitManS)) IF ( InputFileData%TPitManS(K) < 0.0_DbKi ) & CALL SetErrStat( ErrID_Fatal, 'TPitManS('//TRIM( Num2LStr( K ) )//') must not be negative.', ErrStat, ErrMsg, RoutineName ) @@ -2501,7 +2628,7 @@ SUBROUTINE TipBrake_ValidateData( ) !IF ( p%TpBrDT < 0.0_DbKi ) CALL ProgAbort ( ' TpBrDT must not be negative.' ) - !DO K=1,MIN(NumBl,SIZE(InputFileData%TTpBrDp)) + !DO K=1,MIN(InitInp%NumBl,SIZE(InputFileData%TTpBrDp)) ! IF ( InputFileData%TTpBrDp(K) < 0.0_DbKi ) & ! CALL SetErrStat( ErrID_Fatal, 'TTpBrDp(' //TRIM( Num2LStr( K ) )//') must not be negative.', ErrStat, ErrMsg, RoutineName ) ! IF ( InputFileData%TBDepISp(K) < 0.0_DbKi ) & @@ -2609,7 +2736,7 @@ END SUBROUTINE ValidatePrimaryData SUBROUTINE SrvD_SetParameters( InputFileData, p, ErrStat, ErrMsg ) !.................................................................................................................................. - TYPE(SrvD_InputFile), INTENT(IN) :: InputFileData !< Data stored in the module's input file + TYPE(SrvD_InputFile), INTENT(INOUT) :: InputFileData !< Data stored in the module's input file (intent OUT for MOVE_ALLOC) TYPE(SrvD_ParameterType), INTENT(INOUT) :: p !< The module's parameter data INTEGER(IntKi), INTENT(OUT) :: ErrStat !< The error status code CHARACTER(*), INTENT(OUT) :: ErrMsg !< The error message, if an error occurred @@ -2781,9 +2908,10 @@ SUBROUTINE SrvD_SetParameters( InputFileData, p, ErrStat, ErrMsg ) END IF !............................................. - ! Parameters for file output + ! Parameters for file output (not including Bladed DLL logging outputs) !............................................. p%NumOuts = InputFileData%NumOuts + p%NumOuts_DLL = 0 ! set to zero and overwritten if/when the DLL uses it CALL SetOutParam(InputFileData%OutList, p, ErrStat2, ErrMsg2 ) ! requires: p%NumOuts, p%NumBl; sets: p%OutParam. CALL SetErrStat(ErrStat2,ErrMsg2,ErrStat,ErrMsg,RoutineName) @@ -2820,15 +2948,11 @@ SUBROUTINE Yaw_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg REAL(ReKi) :: YawRateCom ! Commanded yaw rate from user-defined routines, rad/s. REAL(ReKi) :: YawPosComInt ! Integrated yaw commanded (from DLL), rad - - - ! Initialize ErrStat - - ErrStat = ErrID_None - ErrMsg = "" + ! Initialize ErrStat + ErrStat = ErrID_None + ErrMsg = "" - !................................................................... ! Override standard yaw control with a linear maneuver if necessary: !................................................................... @@ -2847,18 +2971,26 @@ SUBROUTINE Yaw_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg YawPosCom = OtherState%NacYawI + YawRateCom*( t - p%TYawManS ) ENDIF - + ELSE - + + if (p%YCMode == ControlMode_DLL) then + if (m%dll_data%Yaw_Cntrl == GH_DISCON_YAW_CONTROL_TORQUE .or. m%dll_data%OverrideYawRateWithTorque) then + + y%YawMom = m%dll_data%YawTorqueDemand + + return + end if + end if + !................................................................... ! Calculate standard yaw position and rate commands: !................................................................... YawPosComInt = OtherState%YawPosComInt ! get state value. We don't update the state here. CALL CalculateStandardYaw(t, u, p, m, YawPosCom, YawRateCom, YawPosComInt, ErrStat, ErrMsg) - - ENDIF - + + END IF !................................................................... ! Calculate the yaw moment: !................................................................... @@ -2867,6 +2999,15 @@ SUBROUTINE Yaw_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg - p%YawDamp*( u%YawRate - YawRateCom ) ! {-f(qd,q,t)}DampYaw; + !................................................................... + ! Apply trim case for linearization: + ! prescribed yaw will be wrong in this case..... + !................................................................... + if (p%TrimCase==TrimCase_yaw) then + y%YawMom = y%YawMom + xd%CtrlOffset * p%YawSpr + end if + + END SUBROUTINE Yaw_CalcOutput !---------------------------------------------------------------------------------------------------------------------------------- !> Routine that calculates standard yaw position and rate commands: YawPosCom and YawRateCom. @@ -2913,7 +3054,11 @@ SUBROUTINE CalculateStandardYaw(t, u, p, m, YawPosCom, YawRateCom, YawPosComInt, YawPosCom = YawPosComInt !bjj: was this: LastYawPosCom + YawRateCom*( ZTime - LastTime ) YawRateCom = m%dll_data%YawRateCom - + if (m%dll_data%OverrideYawRateWithTorque .or. m%dll_data%Yaw_Cntrl == GH_DISCON_YAW_CONTROL_TORQUE) then + call SetErrStat(ErrID_Fatal, "Unable to calculate yaw rate control because yaw torque control (or override) was requested from DLL.", ErrStat, ErrMsg, "CalculateStandardYaw") + return + end if + END SELECT @@ -2989,7 +3134,7 @@ SUBROUTINE Yaw_UpdateStates( t, u, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) END SUBROUTINE Yaw_UpdateStates !---------------------------------------------------------------------------------------------------------------------------------- !> Routine for computing the pitch output: blade pitch commands. This routine is used in both loose and tight coupling. -SUBROUTINE Pitch_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMsg ) +SUBROUTINE Pitch_CalcOutput( t, u, p, x, xd, z, OtherState, BlPitchCom, ElecPwr, m, ErrStat, ErrMsg ) !.................................................................................................................................. REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds @@ -2999,8 +3144,9 @@ SUBROUTINE Pitch_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMs TYPE(SrvD_DiscreteStateType), INTENT(IN ) :: xd !< Discrete states at t TYPE(SrvD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t TYPE(SrvD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at t - TYPE(SrvD_OutputType), INTENT(INOUT) :: y !< Outputs computed at t (Input only so that mesh con- + REAL(ReKi), INTENT(INOUT) :: BlPitchCom(:) !< pitch outputs computed at t (Input only so that mesh con- !! nectivity information does not have to be recalculated) + REAL(ReKi), INTENT(IN ) :: ElecPwr !< Electrical power (watts) TYPE(SrvD_MiscVarType), INTENT(INOUT) :: m !< Misc (optimization) variables INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None @@ -3034,40 +3180,38 @@ SUBROUTINE Pitch_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMs CASE ( ControlMode_USER ) ! User-defined from routine PitchCntrl(). - CALL PitchCntrl ( u%BlPitch, y%ElecPwr, u%LSS_Spd, u%TwrAccel, p%NumBl, t, p%DT, p%RootName, y%BlPitchCom ) + CALL PitchCntrl ( u%BlPitch, ElecPwr, u%LSS_Spd, u%TwrAccel, p%NumBl, t, p%DT, p%RootName, BlPitchCom ) CASE ( ControlMode_EXTERN ) ! User-defined from Simulink or LabVIEW. - y%BlPitchCom = u%ExternalBlPitchCom ! copy entire array + BlPitchCom = u%ExternalBlPitchCom ! copy entire array CASE ( ControlMode_DLL ) ! User-defined pitch control from Bladed-style DLL if (p%DLL_Ramp) then - factor = (t - m%LastTimeCalled) / p%DLL_DT - y%BlPitchCom = m%dll_data%PrevBlPitch(1:p%NumBl) + & - factor * ( m%dll_data%BlPitchCom(1:p%NumBl) - m%dll_data%PrevBlPitch(1:p%NumBl) ) + factor = (t - m%LastTimeCalled) / m%dll_data%DLL_DT + BlPitchCom = m%dll_data%PrevBlPitch(1:p%NumBl) + & + factor * ( m%dll_data%BlPitchCom(1:p%NumBl) - m%dll_data%PrevBlPitch(1:p%NumBl) ) else - y%BlPitchCom = m%dll_data%BlPitchCom(1:p%NumBl) + BlPitchCom = m%dll_data%BlPitchCom(1:p%NumBl) end if ! update the filter state once per time step IF ( EqualRealNos( t - p%DT, m%LastTimeFiltered ) ) THEN - m%xd_BlPitchFilter = p%BlAlpha * m%xd_BlPitchFilter + (1.0_ReKi - p%BlAlpha) * y%BlPitchCom + m%xd_BlPitchFilter = p%BlAlpha * m%xd_BlPitchFilter + (1.0_ReKi - p%BlAlpha) * BlPitchCom m%LastTimeFiltered = t END IF - y%BlPitchCom = p%BlAlpha * m%xd_BlPitchFilter + (1.0_ReKi - p%BlAlpha) * y%BlPitchCom + BlPitchCom = p%BlAlpha * m%xd_BlPitchFilter + (1.0_ReKi - p%BlAlpha) * BlPitchCom END SELECT ELSE ! Do not control pitch yet, maintain initial pitch angles. - ! Use the initial blade pitch angles: - y%BlPitchCom = p%BlPitchInit - + BlPitchCom = p%BlPitchInit ENDIF @@ -3083,12 +3227,12 @@ SUBROUTINE Pitch_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMs IF ( t >= OtherState%TPitManE(K) ) THEN ! Override pitch maneuver has ended, blade is locked at BlPitchF. - y%BlPitchCom(K) = p%BlPitchF(K) + BlPitchCom(K) = p%BlPitchF(K) ELSE - - PitManRat = SIGN( p%PitManRat(K), p%BlPitchF(K) - OtherState%BlPitchI(K) ) ! Modify the sign of PitManRat based on the direction of the pitch maneuever - y%BlPitchCom(K) = OtherState%BlPitchI(K) + PitManRat*( t - p%TPitManS(K) ) ! Increment the blade pitch using PitManRat + + PitManRat = SIGN( p%PitManRat(K), p%BlPitchF(K) - OtherState%BlPitchI(K) ) ! Modify the sign of PitManRat based on the direction of the pitch maneuever + BlPitchCom(K) = OtherState%BlPitchI(K) + PitManRat*( t - p%TPitManS(K) ) ! Increment the blade pitch using PitManRat END IF @@ -3097,9 +3241,17 @@ SUBROUTINE Pitch_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrMs ENDDO ! K - blades + !................................................................... + ! Apply trim case for linearization: + !................................................................... + if (p%TrimCase==TrimCase_pitch) then + BlPitchCom = BlPitchCom + xd%CtrlOffset + end if + + END SUBROUTINE Pitch_CalcOutput !---------------------------------------------------------------------------------------------------------------------------------- -!> This routine updates the other states associated with the pitch controller: BegPitMan, BlPitchI, and TPitManE. +!> This routine updates the continuous and other states associated with the pitch controller: BegPitMan, BlPitchI, and TPitManE. SUBROUTINE Pitch_UpdateStates( t, u, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) !.................................................................................................................................. @@ -3124,10 +3276,11 @@ SUBROUTINE Pitch_UpdateStates( t, u, p, x, xd, z, OtherState, m, ErrStat, ErrMsg - ! Initialize ErrStat + ! Initialize ErrStat + + ErrStat = ErrID_None + ErrMsg = "" - ErrStat = ErrID_None - ErrMsg = "" !................................................................... ! Override standard pitch control with a linear maneuver if necessary: @@ -3219,15 +3372,15 @@ SUBROUTINE SetOutParam(OutList, p, ErrStat, ErrMsg ) ! Determine which inputs are not valid InvalidOutput(BlAirFlC3) = ( p%NumBl < 3 ) - InvalidOutput(BlPitchC3) = ( p%NumBl < 3 ) - InvalidOutput( NTMD_XQ) = ( .not. p%CompNTMD ) - InvalidOutput( NTMD_XQD) = ( .not. p%CompNTMD ) - InvalidOutput( NTMD_YQ) = ( .not. p%CompNTMD ) - InvalidOutput( NTMD_YQD) = ( .not. p%CompNTMD ) - InvalidOutput( TTMD_XQ) = ( .not. p%CompTTMD ) - InvalidOutput( TTMD_XQD) = ( .not. p%CompTTMD ) - InvalidOutput( TTMD_YQ) = ( .not. p%CompTTMD ) - InvalidOutput( TTMD_YQD) = ( .not. p%CompTTMD ) + InvalidOutput( BlPitchC3) = ( p%NumBl < 3 ) + InvalidOutput( NTMD_XQ) = ( .not. p%CompNTMD ) + InvalidOutput( NTMD_XQD) = ( .not. p%CompNTMD ) + InvalidOutput( NTMD_YQ) = ( .not. p%CompNTMD ) + InvalidOutput( NTMD_YQD) = ( .not. p%CompNTMD ) + InvalidOutput( TTMD_XQ) = ( .not. p%CompTTMD ) + InvalidOutput( TTMD_XQD) = ( .not. p%CompTTMD ) + InvalidOutput( TTMD_YQ) = ( .not. p%CompTTMD ) + InvalidOutput( TTMD_YQD) = ( .not. p%CompTTMD ) !------------------------------------------------------------------------------------------------- @@ -3493,65 +3646,81 @@ SUBROUTINE Torque_CalcOutput( t, u, p, x, xd, z, OtherState, y, m, ErrStat, ErrM y%ElecPwr = 0.0_ReKi ENDIF + !................................................................... + ! Apply trim case for linearization: + !................................................................... + if (p%TrimCase == TrimCase_torque) then + y%GenTrq = y%GenTrq + xd%CtrlOffset + end if !................................................................................. - ! Calculate the fraction of applied HSS-brake torque, HSSBrFrac: + ! Calculate the magnitude of HSS brake torque from DLL controller !................................................................................. - IF ( (.NOT. EqualRealNos(t, p%THSSBrDp )) .AND. t < p%THSSBrDp ) THEN ! HSS brake not deployed yet. + IF (p%HSSBrMode == ControlMode_DLL) THEN - HSSBrFrac = 0.0_ReKi + y%HSSBrTrqC = m%dll_data%HSSBrTrqDemand + + ELSE + + !................................................................................. + ! Calculate the fraction of applied HSS-brake torque, HSSBrFrac: + !................................................................................. + IF ( t <= p%THSSBrDp ) THEN ! HSS brake not deployed yet. + + HSSBrFrac = 0.0_ReKi - ELSE ! HSS brake deployed. + ELSE ! HSS brake deployed. - SELECT CASE ( p%HSSBrMode ) ! Which HSS brake model are we using? + SELECT CASE ( p%HSSBrMode ) ! Which HSS brake model are we using? - CASE ( ControlMode_NONE) ! None + CASE ( ControlMode_NONE) ! None - HSSBrFrac = 0.0_ReKi + HSSBrFrac = 0.0_ReKi - CASE ( ControlMode_SIMPLE ) ! Simple built-in HSS brake model with linear ramp. + CASE ( ControlMode_SIMPLE ) ! Simple built-in HSS brake model with linear ramp. - IF ( t < p%THSSBrFl ) THEN ! Linear ramp - HSSBrFrac = ( t - p%THSSBrDp )/p%HSSBrDT - ELSE ! Full braking torque - HSSBrFrac = 1.0 - ENDIF + IF ( t < p%THSSBrFl ) THEN ! Linear ramp + HSSBrFrac = ( t - p%THSSBrDp )/p%HSSBrDT + ELSE ! Full braking torque + HSSBrFrac = 1.0 + ENDIF - CASE ( ControlMode_USER ) ! User-defined HSS brake model. + CASE ( ControlMode_USER ) ! User-defined HSS brake model. - CALL UserHSSBr ( y%GenTrq, y%ElecPwr, u%HSS_Spd, p%NumBl, t, p%DT, p%RootName, HSSBrFrac ) + CALL UserHSSBr ( y%GenTrq, y%ElecPwr, u%HSS_Spd, p%NumBl, t, p%DT, p%RootName, HSSBrFrac ) - IF ( ( HSSBrFrac < 0.0_ReKi ) .OR. ( HSSBrFrac > 1.0_ReKi ) ) THEN ! 0 (off) <= HSSBrFrac <= 1 (full); else Abort. - ErrStat = ErrID_Fatal - ErrMsg = 'HSSBrFrac must be between 0.0 (off) and 1.0 (full) (inclusive). Fix logic in routine UserHSSBr().' - RETURN - END IF + IF ( ( HSSBrFrac < 0.0_ReKi ) .OR. ( HSSBrFrac > 1.0_ReKi ) ) THEN ! 0 (off) <= HSSBrFrac <= 1 (full); else Abort. + ErrStat = ErrID_Fatal + ErrMsg = 'HSSBrFrac must be between 0.0 (off) and 1.0 (full) (inclusive). Fix logic in routine UserHSSBr().' + RETURN + END IF - CASE ( ControlMode_DLL ) ! User-defined HSS brake model from Bladed-style DLL - - HSSBrFrac = m%dll_data%HSSBrFrac - y%HSSBrTrqC = ABS( HSSBrFrac*m%dll_data%HSSBrTrqC ) - RETURN + !!!CASE ( ControlMode_DLL ) ! User-defined HSS brake model from Bladed-style DLL + !!! + !!! HSSBrFrac = 1.0_ReKi ! just a placeholder, since it never reaches this case - CASE ( ControlMode_EXTERN ) ! HSS brake model from LabVIEW. + CASE ( ControlMode_EXTERN ) ! HSS brake model from LabVIEW. - HSSBrFrac = u%ExternalHSSBrFrac + HSSBrFrac = u%ExternalHSSBrFrac - ENDSELECT + ENDSELECT - HSSBrFrac = MAX( MIN( HSSBrFrac, 1.0_ReKi ), 0.0_ReKi ) ! make sure we didn't get outside the acceptable range: 0 (off) <= HSSBrFrac <= 1 (full) + HSSBrFrac = MAX( MIN( HSSBrFrac, 1.0_ReKi ), 0.0_ReKi ) ! make sure we didn't get outside the acceptable range: 0 (off) <= HSSBrFrac <= 1 (full) - ENDIF + ENDIF ! Calculate the magnitude of HSS brake torque: - ! to avoid issues with ElastoDyn extrapolating between +/- p%HSSBrTqF, we're going to make this output always positive + !y%HSSBrTrqC = SIGN( HSSBrFrac*p%HSSBrTqF, u%HSS_Spd ) ! Scale the full braking torque by the brake torque fraction and make sure the brake torque resists motion. + y%HSSBrTrqC = HSSBrFrac*p%HSSBrTqF ! Scale the full braking torque by the brake torque fraction (don't worry about the sign here). - !y%HSSBrTrqC = SIGN( HSSBrFrac*p%HSSBrTqF, u%HSS_Spd ) ! Scale the full braking torque by the brake torque fraction and make sure the brake torque resists motion. - y%HSSBrTrqC = ABS( HSSBrFrac*p%HSSBrTqF ) ! Scale the full braking torque by the brake torque fraction and make sure the brake torque resists motion. - + END IF + + ! to avoid issues with ElastoDyn extrapolating between +/- p%HSSBrTqF, we're going to make this output always positive + y%HSSBrTrqC = ABS(y%HSSBrTrqC) + RETURN END SUBROUTINE Torque_CalcOutput @@ -3643,7 +3812,7 @@ SUBROUTINE CalculateTorque( t, u, p, m, GenTrq, ElecPwr, ErrStat, ErrMsg ) TYPE(SrvD_ParameterType), INTENT(IN ) :: p !< Parameters TYPE(SrvD_MiscVarType), INTENT(INOUT) :: m !< Misc (optimization) variables - REAL(ReKi), INTENT( OUT) :: GenTrq !< generator torque + REAL(ReKi), INTENT( OUT) :: GenTrq !< generator torque command REAL(ReKi), INTENT( OUT) :: ElecPwr !< electrical power INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None @@ -3673,118 +3842,117 @@ SUBROUTINE CalculateTorque( t, u, p, m, GenTrq, ElecPwr, ErrStat, ErrMsg ) ElecPwr = 0.0_ReKi - ! Are we doing simple variable-speed control, or using a generator model? + ! Are we doing simple variable-speed control, or using a generator model? - SELECT CASE ( p%VSContrl ) ! Are we using variable-speed control? + SELECT CASE ( p%VSContrl ) ! Are we using variable-speed control? - CASE ( ControlMode_NONE ) ! No variable-speed control. Using a generator model. + CASE ( ControlMode_NONE ) ! No variable-speed control. Using a generator model. - SELECT CASE ( p%GenModel ) ! Which generator model are we using? + SELECT CASE ( p%GenModel ) ! Which generator model are we using? - CASE ( ControlMode_SIMPLE ) ! Simple induction-generator model. + CASE ( ControlMode_SIMPLE ) ! Simple induction-generator model. - Slip = u%HSS_Spd - p%SIG_SySp + Slip = u%HSS_Spd - p%SIG_SySp - IF ( ABS( Slip ) > p%SIG_POSl ) THEN - GenTrq = SIGN( p%SIG_POTq, Slip ) - ELSE - GenTrq = Slip*p%SIG_Slop - ENDIF + IF ( ABS( Slip ) > p%SIG_POSl ) THEN + GenTrq = SIGN( p%SIG_POTq, Slip ) + ELSE + GenTrq = Slip*p%SIG_Slop + ENDIF - ElecPwr = CalculateElecPwr( GenTrq, u, p ) + ElecPwr = CalculateElecPwr( GenTrq, u, p ) - CASE ( ControlMode_ADVANCED ) ! Thevenin-equivalent generator model. + CASE ( ControlMode_ADVANCED ) ! Thevenin-equivalent generator model. - SlipRat = ( u%HSS_Spd - p%TEC_SySp )/p%TEC_SySp + SlipRat = ( u%HSS_Spd - p%TEC_SySp )/p%TEC_SySp - GenTrq = p%TEC_A0*(p%TEC_VLL**2)*SlipRat & - /( p%TEC_C0 + p%TEC_C1*SlipRat + p%TEC_C2*(SlipRat**2) ) + GenTrq = p%TEC_A0*(p%TEC_VLL**2)*SlipRat & + /( p%TEC_C0 + p%TEC_C1*SlipRat + p%TEC_C2*(SlipRat**2) ) - ! trying to refactor so we don't divide by SlipRat, which may be 0 - ! jmj tells me I need not worry about ComDenom being zero because these equations behave nicely - S2 = SlipRat**2 + ! trying to refactor so we don't divide by SlipRat, which may be 0 + ! jmj tells me I need not worry about ComDenom being zero because these equations behave nicely + S2 = SlipRat**2 - ComDenom = ( SlipRat*p%TEC_Re1 - p%TEC_RRes )**2 + (SlipRat*( p%TEC_Xe1 + p%TEC_RLR ))**2 - Current2 = CMPLX( p%TEC_V1a*SlipRat*( SlipRat*p%TEC_Re1 - p%TEC_RRes )/ComDenom , & - -p%TEC_V1a*S2 *( p%TEC_Xe1 + p%TEC_RLR )/ComDenom ) - Currentm = CMPLX( 0.0_ReKi , -p%TEC_V1a/p%TEC_MR ) - Current1 = Current2 + Currentm + ComDenom = ( SlipRat*p%TEC_Re1 - p%TEC_RRes )**2 + (SlipRat*( p%TEC_Xe1 + p%TEC_RLR ))**2 + Current2 = CMPLX( p%TEC_V1a*SlipRat*( SlipRat*p%TEC_Re1 - p%TEC_RRes )/ComDenom , & + -p%TEC_V1a*S2 *( p%TEC_Xe1 + p%TEC_RLR )/ComDenom ) + Currentm = CMPLX( 0.0_ReKi , -p%TEC_V1a/p%TEC_MR ) + Current1 = Current2 + Currentm - PwrLossS = 3.0*( ( ABS( Current1 ) )**2 )*p%TEC_SRes - PwrLossR = 3.0*( ( ABS( Current2 ) )**2 )*p%TEC_RRes + PwrLossS = 3.0*( ( ABS( Current1 ) )**2 )*p%TEC_SRes + PwrLossR = 3.0*( ( ABS( Current2 ) )**2 )*p%TEC_RRes - PwrMech = GenTrq*u%HSS_Spd - ElecPwr = PwrMech - PwrLossS - PwrLossR + PwrMech = GenTrq*u%HSS_Spd + ElecPwr = PwrMech - PwrLossS - PwrLossR - CASE ( ControlMode_USER ) ! User-defined generator model. + CASE ( ControlMode_USER ) ! User-defined generator model. - ! CALL UserGen ( u%HSS_Spd, u%LSS_Spd, p%NumBl, t, DT, p%GenEff, DelGenTrq, DirRoot, GenTrq, ElecPwr ) - CALL UserGen ( u%HSS_Spd, u%LSS_Spd, p%NumBl, t, p%DT, p%GenEff, 0.0_ReKi, p%RootName, GenTrq, ElecPwr ) + ! CALL UserGen ( u%HSS_Spd, u%LSS_Spd, p%NumBl, t, DT, p%GenEff, DelGenTrq, DirRoot, GenTrq, ElecPwr ) + CALL UserGen ( u%HSS_Spd, u%LSS_Spd, p%NumBl, t, p%DT, p%GenEff, 0.0_ReKi, p%RootName, GenTrq, ElecPwr ) - END SELECT + END SELECT - CASE ( ControlMode_SIMPLE ) ! Simple variable-speed control. + CASE ( ControlMode_SIMPLE ) ! Simple variable-speed control. - if ( u%HSS_Spd < 0.0_ReKi) then - if (.not. equalRealNos(u%HSS_Spd, 0.0_ReKi) ) then - call SetErrStat( ErrID_Fatal, "u%HSS_Spd is negative. Simple variable-speed control model "//& - "is not valid for motoring situations.", ErrStat, ErrMsg, RoutineName) - return - end if - end if + if ( u%HSS_Spd < 0.0_ReKi) then + if (.not. equalRealNos(u%HSS_Spd, 0.0_ReKi) ) then + call SetErrStat( ErrID_Fatal, "u%HSS_Spd is negative. Simple variable-speed control model "//& + "is not valid for motoring situations.", ErrStat, ErrMsg, RoutineName) + return + end if + end if - ! Compute the generator torque, which depends on which region we are in: + ! Compute the generator torque, which depends on which region we are in: - IF ( u%HSS_Spd >= p%VS_RtGnSp ) THEN ! We are in region 3 - torque is constant - GenTrq = p%VS_RtTq - ELSEIF ( u%HSS_Spd < p%VS_TrGnSp ) THEN ! We are in region 2 - torque is proportional to the square of the generator speed - GenTrq = p%VS_Rgn2K* (u%HSS_Spd**2) - ELSE ! We are in region 2 1/2 - simple induction generator transition region - GenTrq = p%VS_Slope*( u%HSS_Spd - p%VS_SySp ) - ENDIF + IF ( u%HSS_Spd >= p%VS_RtGnSp ) THEN ! We are in region 3 - torque is constant + GenTrq = p%VS_RtTq + ELSEIF ( u%HSS_Spd < p%VS_TrGnSp ) THEN ! We are in region 2 - torque is proportional to the square of the generator speed + GenTrq = p%VS_Rgn2K* (u%HSS_Spd**2) + ELSE ! We are in region 2 1/2 - simple induction generator transition region + GenTrq = p%VS_Slope*( u%HSS_Spd - p%VS_SySp ) + ENDIF - ! It's not possible to motor using this control scheme, so the generator efficiency is always subtractive. + ! It's not possible to motor using this control scheme, so the generator efficiency is always subtractive. - ElecPwr = GenTrq*u%HSS_Spd*p%GenEff - !y%ElecPwr = CalculateElecPwr( y%GenTrq, u, p ) + ElecPwr = GenTrq*u%HSS_Spd*p%GenEff + !y%ElecPwr = CalculateElecPwr( y%GenTrq, u, p ) - CASE ( ControlMode_USER ) ! User-defined variable-speed control for routine UserVSCont(). + CASE ( ControlMode_USER ) ! User-defined variable-speed control for routine UserVSCont(). - ! CALL UserVSCont ( u%HSS_Spd, u%LSS_Spd, p%NumBl, t, DT, p%GenEff, DelGenTrq, DirRoot, GenTrq, ElecPwr ) - CALL UserVSCont ( u%HSS_Spd, u%LSS_Spd, p%NumBl, t, p%DT, p%GenEff, 0.0_ReKi, p%RootName, GenTrq, ElecPwr ) + CALL UserVSCont ( u%HSS_Spd, u%LSS_Spd, p%NumBl, t, p%DT, p%GenEff, 0.0_ReKi, p%RootName, GenTrq, ElecPwr ) - CASE ( ControlMode_DLL ) ! User-defined variable-speed control from Bladed-style DLL + CASE ( ControlMode_DLL ) ! User-defined variable-speed control from Bladed-style DLL - ! bjj: I believe this is how the old logic worked, but perhaps now we can be more clever about checking if the generator is off + ! bjj: I believe this is how the old logic worked, but perhaps now we can be more clever about checking if the generator is off - IF ( m%dll_data%GenState /= 0_IntKi ) THEN ! generator is on + IF ( m%dll_data%GenState /= 0_IntKi ) THEN ! generator is on - GenTrq = m%dll_data%GenTrq + GenTrq = m%dll_data%GenTrq ElecPwr = CalculateElecPwr( GenTrq, u, p ) - ELSE ! generator is off + ELSE ! generator is off - GenTrq = 0.0_ReKi - ElecPwr = 0.0_ReKi + GenTrq = 0.0_ReKi + ElecPwr = 0.0_ReKi - END IF + END IF - CASE ( ControlMode_EXTERN ) ! User-defined variable-speed control from Simulink or LabVIEW. + CASE ( ControlMode_EXTERN ) ! User-defined variable-speed control from Simulink or LabVIEW. - GenTrq = u%ExternalGenTrq - ElecPwr = u%ExternalElecPwr + GenTrq = u%ExternalGenTrq + ElecPwr = u%ExternalElecPwr - END SELECT + END SELECT ! Lets turn the generator offline for good if ( GenTiStp = .FALSE. ) .AND. ( ElecPwr <= 0.0 ): @@ -3804,7 +3972,7 @@ FUNCTION CalculateElecPwr( GenTrq, u, p ) TYPE(SrvD_InputType), INTENT(IN) :: u !< Inputs at t TYPE(SrvD_ParameterType), INTENT(IN) :: p !< Parameters -REAL(ReKi) :: CalculateElecPwr !< The result of this function +REAL(ReKi) :: CalculateElecPwr !< The result of this function !! The generator efficiency is either additive for motoring, !! or subtractive for generating power. @@ -3813,12 +3981,12 @@ FUNCTION CalculateElecPwr( GenTrq, u, p ) CalculateElecPwr = GenTrq * u%HSS_Spd * p%GenEff ELSE CalculateElecPwr = GenTrq * u%HSS_Spd / p%GenEff - ENDIF + ENDIF END FUNCTION CalculateElecPwr !---------------------------------------------------------------------------------------------------------------------------------- !> This routine calculates the partials with respect to inputs of the drive-train torque outputs: GenTrq and ElecPwr -SUBROUTINE Torque_JacobianPInput( t, u, p, x, xd, z, OtherState, m, GenTrq, ElecPwr, ErrStat, ErrMsg ) +SUBROUTINE Torque_JacobianPInput( t, u, p, x, xd, z, OtherState, m, GenTrq_du, ElecPwr_du, ErrStat, ErrMsg ) !.................................................................................................................................. REAL(DbKi), INTENT(IN ) :: t !< Current simulation time in seconds @@ -3829,8 +3997,8 @@ SUBROUTINE Torque_JacobianPInput( t, u, p, x, xd, z, OtherState, m, GenTrq, Elec TYPE(SrvD_ConstraintStateType), INTENT(IN ) :: z !< Constraint states at t TYPE(SrvD_OtherStateType), INTENT(IN ) :: OtherState !< Other states at t TYPE(SrvD_MiscVarType), INTENT(INOUT) :: m !< Misc (optimization) variables - REAL(R8Ki), INTENT( OUT) :: GenTrq !< partial derivative of generator torque output with respect to HSS_Spd input - REAL(R8Ki), INTENT( OUT) :: ElecPwr !< partial derivative of electrical power output with respect to HSS_Spd input + REAL(R8Ki), INTENT( OUT) :: GenTrq_du !< partial derivative of generator torque output with respect to HSS_Spd input + REAL(R8Ki), INTENT( OUT) :: ElecPwr_du !< partial derivative of electrical power output with respect to HSS_Spd input INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None @@ -3845,11 +4013,11 @@ SUBROUTINE Torque_JacobianPInput( t, u, p, x, xd, z, OtherState, m, GenTrq, Elec !................................................................................. IF ( OtherState%GenOnLine .and. .not. OtherState%Off4Good ) THEN ! Generator is on line. - CALL CalculateTorqueJacobian( t, u, p, m, GenTrq, ElecPwr, ErrStat, ErrMsg ) + CALL CalculateTorqueJacobian( t, u, p, m, GenTrq_du, ElecPwr_du, ErrStat, ErrMsg ) if (ErrStat >= AbortErrLev) return ELSE ! Generator is off line. - GenTrq = 0.0_R8Ki - ElecPwr = 0.0_R8Ki + GenTrq_du = 0.0_R8Ki + ElecPwr_du = 0.0_R8Ki ENDIF @@ -3884,7 +4052,6 @@ SUBROUTINE CalculateTorqueJacobian( t, u, p, m, GenTrq_du, ElecPwr_du, ErrStat, REAL(R8Ki) :: Current2_i, Current2_i_du ! Current passing through the rotor (amps) and its derivative w.r.t. u%HSS_Spd REAL(R8Ki) :: GenTrq ! generator torque - REAL(R8Ki) :: PwrMech ! Mechanical power in generator REAL(R8Ki) :: ComDenom, ComDenom_du ! temporary variable (common denominator) REAL(R8Ki) :: PwrLossS_du ! Power loss in the stator (watts) and its derivative w.r.t. u%HSS_Spd @@ -3929,8 +4096,10 @@ SUBROUTINE CalculateTorqueJacobian( t, u, p, m, GenTrq_du, ElecPwr_du, ErrStat, GenTrq_du = p%SIG_Slop ENDIF - - IF ( GenTrq >= 0.0_ReKi ) THEN + ! Calculate the electrical powerF + ! As generator: ElecPwr = GenTrq * u%HSS_Spd * m%GenEff + ! As motor: ElecPwr = GenTrq * u%HSS_Spd / m%GenEff + IF ( GenTrq >= 0.0_R8Ki ) THEN !ElecPwr = GenTrq * u%HSS_Spd * p%GenEff ElecPwr_du = (GenTrq_du * u%HSS_Spd + GenTrq) * p%GenEff ELSE diff --git a/modules/servodyn/src/ServoDyn_Driver.f90 b/modules/servodyn/src/ServoDyn_Driver.f90 index e19d3dd4f0..7ba7135f3f 100644 --- a/modules/servodyn/src/ServoDyn_Driver.f90 +++ b/modules/servodyn/src/ServoDyn_Driver.f90 @@ -26,7 +26,7 @@ PROGRAM SrvD_Driver IMPLICIT NONE - INTEGER(IntKi), PARAMETER :: NumInp = 1 !< Number of inputs sent to SrvD_UpdateStates + INTEGER(IntKi), PARAMETER :: NumInp = 3 !< Number of inputs sent to SrvD_UpdateStates ! Program variables @@ -51,12 +51,13 @@ PROGRAM SrvD_Driver INTEGER(IntKi) :: n !< Loop counter (for time step) + INTEGER(IntKi) :: j !< Loop counter (for interpolation time history) INTEGER(IntKi) :: ErrStat !< Status of error message CHARACTER(ErrMsgLen) :: ErrMsg !< Error message if ErrStat /= ErrID_None REAL(R8Ki), allocatable :: dYdu(:,:) INTEGER(IntKi) :: Un - INTEGER(IntKi), parameter :: nMax = 80 + INTEGER(IntKi) :: nMax CHARACTER(1024) :: OutFile CHARACTER(20) :: FlagArg !< Flag argument from command line @@ -83,16 +84,37 @@ PROGRAM SrvD_Driver ! Set the driver's request for time interval here: - TimeInterval = 0.25 ! Glue code's request for delta time (likely based on information from other modules) - - + TimeInterval = 0.01 ! s + InitInData%InputFile = 'ServoDyn.dat' + InitInData%RootName = OutFile(1:(len_trim(OutFile)-4)) + InitInData%NumBl = 3 + InitInData%gravity = 9.81 !m/s^2 + InitInData%r_N_O_G = (/ 90.0, 0.0, 0.0 /) ! m, position of nacelle (for NTMD) + InitInData%r_TwrBase = (/ 0.0, 0.0, 0.0 /) ! m, position of tower base (for TTMD) + InitInData%TMax = 10.0 !s + InitInData%AirDens = 1.225 !kg/m^3 + InitInData%AvgWindSpeed = 10.0 !m/s + InitInData%Linearize = .false. + InitInData%NumSC2Ctrl = 0 + InitInData%NumCtrl2SC = 0 + + CALL AllocAry(InitInData%BlPitchInit, InitInData%NumBl, 'BlPitchInit', ErrStat, ErrMsg) + IF ( ErrStat /= ErrID_None ) THEN + CALL WrScr( ErrMsg ) + END IF + InitInData%BlPitchInit = 5.0*pi/180.0 ! radians + + ! Initialize the module CALL SrvD_Init( InitInData, u(1), p, x, xd, z, OtherState, y, misc, TimeInterval, InitOutData, ErrStat, ErrMsg ) IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary CALL WrScr( ErrMsg ) + IF (ErrStat >= AbortErrLev) call ProgAbort('') END IF + nMax = nint(InitInData%TMax/TimeInterval) + ! Destroy initialization data @@ -100,36 +122,62 @@ PROGRAM SrvD_Driver CALL SrvD_DestroyInitOutput( InitOutData, ErrStat, ErrMsg ) + Time = 0.0_ReKi + DO j = 1, NumInp + InputTime(j) = Time - j*TimeInterval + END DO + DO j = 2, NumInp + CALL SrvD_CopyInput (u(1), u(j), MESH_NEWCOPY, ErrStat, ErrMsg) + END DO + !............................................................................................................................... ! Check the results of the Jacobian routines !............................................................................................................................... - Time = 0.0_ReKi - + + CALL SrvD_CalcOutput( Time, u(1), p, x, xd, z, OtherState, y, misc, ErrStat, ErrMsg ) + IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary + CALL WrScr( ErrMsg ) + END IF + write(Un,'(600(ES15.5,1x))') Time, y%BlPitchCom, y%WriteOutput + + + DO n = 0,nMax ! Modify u for inputs at n (likely from the outputs of another module or a set of test conditions) here: + DO j = NumInp-1, 1, -1 + CALL SrvD_CopyInput (u(j), u(j+1), MESH_UPDATECOPY, ErrStat, ErrMsg) + InputTime(j+1) = InputTime(j) + END DO + InputTime(1) = Time + u(1)%BlPitch = y%BlPitchCom - u(1)%HSS_Spd = (2000.0_ReKi)/nMax * RPM2RPS * n + !u(1)%HSS_Spd = (2000.0_ReKi)/nMax * RPM2RPS * n + CALL SrvD_UpdateStates( Time, n, u, InputTime, p, x, xd, z, OtherState, misc, ErrStat, ErrMsg ) + IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary + CALL WrScr( ErrMsg ) + END IF + ! Calculate outputs at n - + Time = (n+1)*TimeInterval CALL SrvD_CalcOutput( Time, u(1), p, x, xd, z, OtherState, y, misc, ErrStat, ErrMsg ) IF ( ErrStat /= ErrID_None ) THEN ! Check if there was an error and do something about it if necessary CALL WrScr( ErrMsg ) END IF - call SrvD_JacobianPInput( Time, u(1), p, x, xd, z, OtherState, y, misc, ErrStat, ErrMsg, dYdu) + !call SrvD_JacobianPInput( Time, u(1), p, x, xd, z, OtherState, y, misc, ErrStat, ErrMsg, dYdu) - write(Un,'(100(ES15.5,1x))') u(1)%Yaw, u(1)%YawRate, u(1)%HSS_Spd, y%YawMom, y%GenTrq, y%ElecPwr, dYdu(4,1), dYdu(4,2), dYdu(5,3), dYdu(6,3) + !write(Un,'(100(ES15.5,1x))') u(1)%Yaw, u(1)%YawRate, u(1)%HSS_Spd, y%YawMom, y%GenTrq, y%ElecPwr, dYdu(4,1), dYdu(4,2), dYdu(5,3), dYdu(6,3) + write(Un,'(600(ES15.5,1x))') Time, y%BlPitchCom, y%WriteOutput END DO close (un) - !............................................................................................................................... ! Routine to terminate program execution !............................................................................................................................... diff --git a/modules/servodyn/src/ServoDyn_Registry.txt b/modules/servodyn/src/ServoDyn_Registry.txt index 26cfe9d031..a157ab73e6 100644 --- a/modules/servodyn/src/ServoDyn_Registry.txt +++ b/modules/servodyn/src/ServoDyn_Registry.txt @@ -29,6 +29,9 @@ typedef ^ InitInputType ReKi AvgWindSpeed - - - "average wind speed for the simu typedef ^ InitInputType ReKi AirDens - - - "air density" kg/m^3 typedef ^ InitInputType IntKi NumSC2Ctrl - - - "number of controller inputs [from supercontroller]" - typedef ^ InitInputType IntKi NumCtrl2SC - - - "number of controller outputs [to supercontroller]" - +typedef ^ InitInputType IntKi TrimCase - - - "Controller parameter to be trimmed {1:yaw; 2:torque; 3:pitch} [used only if CalcSteady=True]" - +typedef ^ InitInputType ReKi TrimGain - - - "Proportional gain for the rotational speed error (>0) [used only if TrimCase>0]" "rad/(rad/s) for yaw or pitch; Nm/(rad/s) for torque" +typedef ^ InitInputType ReKi RotSpeedRef - - - "Reference rotor speed" "rad/s" # Define outputs from the initialization routine here: typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} - - "Names of the output-to-file channels" - @@ -118,6 +121,7 @@ typedef ^ SrvD_InputFile ReKi GenPwr_Dem - - - "Record 13: Demanded power [used typedef ^ SrvD_InputFile IntKi DLL_NumTrq - - - "Record 26: No. of points in torque-speed look-up table {0 = none and use the optimal mode PARAMETERs instead, nonzero = ignore the optimal mode PARAMETERs by setting Gain_OM (Record 16) to 0.0} [used only with DLL Interface]" - typedef ^ SrvD_InputFile ReKi GenSpd_TLU {:} - - "Records R:2:R+2*DLL_NumTrq-2: Generator speed values in look-up table [used only with DLL Interface]" rad/s typedef ^ SrvD_InputFile ReKi GenTrq_TLU {:} - - "Records R+1:2:R+2*DLL_NumTrq-1: Generator torque values in look-up table [used only with DLL Interface]" Nm +typedef ^ SrvD_InputFile LOGICAL UseLegacyInterface - - - "Flag that determines if the legacy Bladed interface is (legacy=DISCON with avrSWAP instead of CONTROLLER)" - typedef ^ SrvD_InputFile LOGICAL CompNTMD - - - "Compute nacelle tuned mass damper {true/false}" - typedef ^ SrvD_InputFile CHARACTER(1024) NTMDfile - - - "File for nacelle tuned mass damper (quoted string)" - typedef ^ SrvD_InputFile LOGICAL CompTTMD - - - "Compute tower tuned mass damper {true/false}" - @@ -125,16 +129,75 @@ typedef ^ SrvD_InputFile CHARACTER(1024) TTMDfile - - - "File for tower tuned ma # ..... Data for using Bladed DLLs ....................................................................................................... typedef ^ BladedDLLType SiKi avrSWAP {:} - - "The swap array: used to pass data to and from the DLL controller" "see Bladed DLL documentation" -typedef ^ BladedDLLType ReKi HSSBrFrac - - - "Fraction of full braking torque: 0 (off) <= HSSBrFrac <= 1 (full) - from Bladed DLL" - -typedef ^ BladedDLLType ReKi HSSBrTrqC - - - "Braking torque" N-m +typedef ^ BladedDLLType ReKi HSSBrTrqDemand - - - "Demanded braking torque - from Bladed DLL" - typedef ^ BladedDLLType ReKi YawRateCom - - - "Nacelle yaw rate demanded from Bladed DLL" rad/s typedef ^ BladedDLLType ReKi GenTrq - - - "Electrical generator torque from Bladed DLL" N-m -typedef ^ BladedDLLType IntKi GenState - - - "Generator state from Bladed DLL" N-m -#typedef ^ BladedDLLType ReKi ElecPwr - - - "Electrical power sent to Bladed DLL" W +typedef ^ BladedDLLType IntKi GenState - - - "Generator state from Bladed DLL" - typedef ^ BladedDLLType ReKi BlPitchCom 3 - - "Commanded blade pitch angles" radians typedef ^ BladedDLLType ReKi PrevBlPitch 3 - - "Previously commanded blade pitch angles" radians typedef ^ BladedDLLType ReKi BlAirfoilCom 3 - - "Commanded Airfoil UserProp for blade. Passed to AD15 for airfoil interpolation (must be same units as given in AD15 airfoil tables)" - +typedef ^ BladedDLLType ReKi ElecPwr_prev - - - "Electrical power (from previous step), sent to Bladed DLL" W +typedef ^ BladedDLLType ReKi GenTrq_prev - - - "Electrical generator torque (from previous step), sent to Bladed DLL" N-m typedef ^ BladedDLLType SiKi SCoutput {:} - - "controller output to supercontroller" - +typedef ^ BladedDLLType logical initialized - - - "flag that determines if DLL has been called (for difference between CalcOutput and UpdateStates)" - +typedef ^ BladedDLLType INTEGER NumLogChannels - - - "number of log channels from controller" - +typedef ^ BladedDLLType OutParmType LogChannels_OutParam {:} - - "Names and units (and other characteristics) of logging outputs from DLL" - +typedef ^ BladedDLLType ReKi LogChannels {:} - - "logging outputs from controller" - +typedef ^ BladedDLLType IntKi ErrStat - - - "error message from external controller API" - +typedef ^ BladedDLLType CHARACTER(ErrMsgLen) ErrMsg - - - "error message from external controller API" - +typedef ^ BladedDLLType R8Ki CurrentTime - - - "Current Simulation Time" s +typedef ^ BladedDLLType IntKi SimStatus - - - "simulation status (see avrSWAP(1): Status flag set as follows: 0 if this is the first call, 1 for all subsequent time steps, -1 if this is the final call at the end of the simulation)" - +typedef ^ BladedDLLType IntKi ShaftBrakeStatusBinaryFlag - - - "binary flag indicating (on/off) status for shaft brake 1, shaft brake 2, generator brake, shaft brake 3, or brake torque set separately (0, 1, or 16 allowed in FAST)"- +typedef ^ BladedDLLType LOGICAL HSSBrDeployed - - - "Whether the HSS brake has been deployed" - +typedef ^ BladedDLLType R8Ki TimeHSSBrFullyDeployed - - - "Time at which the controller high-speed shaft is fully deployed" s +typedef ^ BladedDLLType R8Ki TimeHSSBrDeployed - - - "Time at which the controller high-speed shaft is first deployed" s +typedef ^ BladedDLLType LOGICAL OverrideYawRateWithTorque - - - "acts similiar to Yaw_Cntrl" - +typedef ^ BladedDLLType ReKi YawTorqueDemand - - - "Demanded yaw actuator torque (override of yaw rate control)" Nm +## these are INPUTS copied to the DLL: +typedef ^ BladedDLLType ReKi BlPitchInput {:} - - "Input blade pitch angles" radians +typedef ^ BladedDLLType ReKi YawAngleFromNorth - - - "Yaw angle of the nacelle relative to North (see NacYaw_North)" rad +typedef ^ BladedDLLType ReKi HorWindV - - - "Horizontal hub-height wind velocity magnitude" m/s +typedef ^ BladedDLLType ReKi HSS_Spd - - - "High-speed shaft (HSS) speed" rad/s +typedef ^ BladedDLLType ReKi YawErr - - - "Yaw error" radians +typedef ^ BladedDLLType ReKi RotSpeed - - - "Rotor azimuth angular speed" rad/s +typedef ^ BladedDLLType ReKi YawBrTAxp - - - "Tower-top / yaw bearing fore-aft (translational) acceleration (absolute)" m/s^2 +typedef ^ BladedDLLType ReKi YawBrTAyp - - - "Tower-top / yaw bearing side-to-side (translational) acceleration (absolute)" m/s^2 +typedef ^ BladedDLLType ReKi LSSTipMys - - - "Nonrotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader)" N-m +typedef ^ BladedDLLType ReKi LSSTipMzs - - - "Nonrotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader)" N-m +typedef ^ BladedDLLType ReKi LSSTipMya - - - "Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader)" N-m +typedef ^ BladedDLLType ReKi LSSTipMza - - - "Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader)" N-m +typedef ^ BladedDLLType ReKi LSSTipPxa - - - "Rotor azimuth angle (position)" radians +typedef ^ BladedDLLType ReKi Yaw - - - "Current nacelle yaw" radians +typedef ^ BladedDLLType ReKi YawRate - - - "Current nacelle yaw rate" rad/s +typedef ^ BladedDLLType ReKi YawBrMyn - - - "Rotating (with nacelle) tower-top / yaw bearing pitch moment" N-m +typedef ^ BladedDLLType ReKi YawBrMzn - - - "Tower-top / yaw bearing yaw moment" N-m +typedef ^ BladedDLLType ReKi NcIMURAxs - - - "Nacelle inertial measurement unit angular (rotational) acceleration (absolute)" rad/s^2 +typedef ^ BladedDLLType ReKi NcIMURAys - - - "Nacelle inertial measurement unit angular (rotational) acceleration (absolute)" rad/s^2 +typedef ^ BladedDLLType ReKi NcIMURAzs - - - "Nacelle inertial measurement unit angular (rotational) acceleration (absolute)" rad/s^2 +typedef ^ BladedDLLType ReKi RotPwr - - - "Rotor power (this is equivalent to the low-speed shaft power)" W +typedef ^ BladedDLLType ReKi LSSTipMxa - - - "Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader)" N-m +typedef ^ BladedDLLType ReKi RootMyc 3 - - "Out-of-plane moment (i.e., the moment caused by out-of-plane forces) at the blade root for each of the blades (max 3)" N-m +typedef ^ BladedDLLType ReKi RootMxc 3 - - "In-plane moment (i.e., the moment caused by in-plane forces) at the blade root" N-m +## these are PARAMETERS sent to the DLL (THEIR VALUES SHOULD NOT CHANGE DURING SIMULATION): +typedef ^ BladedDLLType DbKi DLL_DT - - - "interval for calling DLL (integer multiple number of DT)" s +typedef ^ BladedDLLType CHARACTER(1024) DLL_InFile - - - "Name of input file used in DLL" - +typedef ^ BladedDLLType CHARACTER(1024) RootName - - - "RootName for writing output files" - +typedef ^ BladedDLLType ReKi GenTrq_Dem - - - "Demanded generator torque above rated" Nm +typedef ^ BladedDLLType ReKi GenSpd_Dem - - - "Demanded generator speed above rated" rad/s +typedef ^ BladedDLLType ReKi Ptch_Max - - - "Maximum pitch angle" rad +typedef ^ BladedDLLType ReKi Ptch_Min - - - "Minimum pitch angle" rad +typedef ^ BladedDLLType ReKi Ptch_SetPnt - - - "Below-rated pitch angle set-point" rad +typedef ^ BladedDLLType ReKi PtchRate_Max - - - "Maximum pitch rate" rad/s +typedef ^ BladedDLLType ReKi PtchRate_Min - - - "Minimum pitch rate (most negative value allowed)" rad/s +typedef ^ BladedDLLType ReKi GenPwr_Dem - - - "Demanded power (This is not valid for variable-speed, pitch-regulated controllers.)" W +typedef ^ BladedDLLType ReKi Gain_OM - - - "Optimal mode gain" Nm/(rad/s)^2 +typedef ^ BladedDLLType ReKi GenSpd_MaxOM - - - "Optimal mode maximum speed" rad/s +typedef ^ BladedDLLType ReKi GenSpd_MinOM - - - "Minimum generator speed" rad/s +typedef ^ BladedDLLType IntKi Ptch_Cntrl - - - "Pitch control: 0 = collective; 1 = individual" - +typedef ^ BladedDLLType IntKi DLL_NumTrq - - - "No. of points in torque-speed look-up table, 0 = none and use the optimal mode PARAMETERs instead; nonzero = ignore the optimal mode PARAMETERs by setting Record 16 to 0.0" - +typedef ^ BladedDLLType ReKi GenSpd_TLU {:} - - "Table (array) containing DLL_NumTrq generator speeds for the torque-speed table look-up (TLU) -- this should be defined using an array constructor; for example, if DLL_NumTrq = 3, GenSpd_TLU(DLL_NumTrq) = (/ 0.0, 99.9, 999.9 /)" rad/s +typedef ^ BladedDLLType ReKi GenTrq_TLU {:} - - "Table (array) containing DLL_NumTrq generator torques for the torque-speed table look-up (TLU) -- this should be defined using an array constructor, for example, if DLL_NumTrq = 3, GenTrq_TLU(DLL_NumTrq) = (/ 0.0, 10, 200.0 /)" Nm +typedef ^ BladedDLLType IntKi Yaw_Cntrl - - - "Yaw control: 0 = rate; 1 = torque" - # ..... States .................................................................................................................... # Define continuous (differentiable) states here: @@ -143,6 +206,7 @@ typedef ^ ContinuousStateType TMD_ContinuousStateType NTMD - - - "TMD module sta typedef ^ ContinuousStateType TMD_ContinuousStateType TTMD - - - "TMD module states - tower" - # Define discrete (nondifferentiable) states here: +typedef ^ DiscreteStateType ReKi CtrlOffset - - - "Controller offset parameter" N-m #typedef ^ DiscreteStateType ReKi BlPitchFilter {:} - - "blade pitch filter" - typedef ^ DiscreteStateType TMD_DiscreteStateType NTMD - - - "TMD module states - nacelle" - typedef ^ DiscreteStateType TMD_DiscreteStateType TTMD - - - "TMD module states - tower" - @@ -187,7 +251,6 @@ typedef ^ MiscVarType TMD_MiscVarType TTMD - - - "TMD module misc vars - tower" # Time step for integration of continuous states (if a fixed-step integrator is used) and update of discrete states: typedef ^ ParameterType DbKi DT - - - "Time step for continuous state integration & discrete state update" seconds typedef ^ ParameterType DbKi HSSBrDT - - - "Time it takes for HSS brake to reach full deployment once deployed" seconds -typedef ^ ParameterType ReKi HSSBrFrac - - - "Fraction of full braking torque: 0 (off) <= HSSBrFrac <= 1 (full), (-)" - typedef ^ ParameterType ReKi HSSBrTqF - - - "Fully deployed HSS brake torque" typedef ^ ParameterType ReKi SIG_POSl - - - "Pullout slip" typedef ^ ParameterType ReKi SIG_POTq - - - "Pullout torque" @@ -212,7 +275,6 @@ typedef ^ ParameterType ReKi GenEff - - - "Generator efficiency" typedef ^ ParameterType ReKi BlPitchInit {:} - - "Initial blade pitch angles" radians typedef ^ ParameterType ReKi BlPitchF {:} - - "Final blade pitch" typedef ^ ParameterType ReKi PitManRat {:} - - "Pitch rates at which override pitch maneuvers head toward final pitch angles (does not include sign)" rad/s -typedef ^ ParameterType ReKi BlAlpha typedef ^ ParameterType ReKi YawManRat - - - "Yaw rate at which override yaw maneuver head toward for final yaw angle (does not include sign)" rad/s typedef ^ ParameterType ReKi NacYawF - - - "Final yaw angle after override yaw maneuver" typedef ^ ParameterType ReKi SpdGenOn - - - "Generator speed to turn on the generator for a startup" @@ -252,55 +314,46 @@ typedef ^ ParameterType LOGICAL CompNTMD - - - "Compute nacelle tuned mass dampe typedef ^ ParameterType LOGICAL CompTTMD - - - "Compute tower tuned mass damper {true/false}" - # parameters for output typedef ^ ParameterType IntKi NumOuts - - - "Number of parameters in the output list (number of outputs requested)" - +typedef ^ ParameterType IntKi NumOuts_DLL - - - "Number of logging channels output from the DLL (set at initialization)" - typedef ^ ParameterType CHARACTER(1024) RootName - - - "RootName for writing output files" - typedef ^ ParameterType OutParmType OutParam {:} - - "Names and units (and other characteristics) of all requested output parameters" - typedef ^ ParameterType CHARACTER(1) Delim - - - "Column delimiter for output text files" - # parameters for Bladed Interface (dynamic-link library) typedef ^ ParameterType LOGICAL UseBladedInterface - - - "Flag that determines if BladedInterface was used" - +typedef ^ ParameterType LOGICAL UseLegacyInterface - - - "Flag that determines if the legacy Bladed interface is (legacy=DISCON with avrSWAP instead of CONTROLLER)" - +typedef ^ ParameterType DLL_Type DLL_Trgt - - - "The addresses and names of the Bladed DLL and its procedure" - typedef ^ ParameterType LOGICAL DLL_Ramp - - - "determines if there is a DLL_DT-ramp time delay (true only when DLL_DT /= DT)" - -typedef ^ ParameterType DbKi DLL_DT - - - "interval for calling DLL (integer multiple number of DT)" s -typedef ^ ParameterType IntKi DLL_NumTrq - - - "No. of points in torque-speed look-up table, 0 = none and use the optimal mode PARAMETERs instead; nonzero = ignore the optimal mode PARAMETERs by setting Record 16 to 0.0" - -typedef ^ ParameterType IntKi Ptch_Cntrl - - - "Pitch control: 0 = collective; 1 = individual" - -typedef ^ ParameterType ReKi Gain_OM - - - "Optimal mode gain" Nm/(rad/s)^2 -typedef ^ ParameterType ReKi GenPwr_Dem - - - "Demanded power" W -typedef ^ ParameterType ReKi GenSpd_Dem - - - "Demanded generator speed above rated" rad/s -typedef ^ ParameterType ReKi GenSpd_MaxOM - - - "Optimal mode maximum speed" rad/s -typedef ^ ParameterType ReKi GenSpd_MinOM - - - "Minimum generator speed" rad/s -typedef ^ ParameterType ReKi GenSpd_TLU {:} - - "Table (array) containing DLL_NumTrq generator speeds for the torque-speed table look-up (TLU) -- this should be defined using an array constructor; for example, if DLL_NumTrq = 3, GenSpd_TLU(DLL_NumTrq) = (/ 0.0, 99.9, 999.9 /)" rad/s -typedef ^ ParameterType ReKi GenTrq_Dem - - - "Demanded generator torque" Nm -typedef ^ ParameterType ReKi GenTrq_TLU {:} - - "Table (array) containing DLL_NumTrq generator torques for the torque-speed table look-up (TLU) -- this should be defined using an array constructor, for example, if DLL_NumTrq = 3, GenTrq_TLU(DLL_NumTrq) = (/ 0.0, 10, 200.0 /)" Nm -typedef ^ ParameterType ReKi Ptch_Max - - - "Maximum pitch angle" rad -typedef ^ ParameterType ReKi Ptch_Min - - - "Minimum pitch angle" rad -typedef ^ ParameterType ReKi Ptch_SetPnt - - - "Below-rated pitch angle set-point" rad -typedef ^ ParameterType ReKi PtchRate_Max - - - "Maximum pitch rate" rad/s -typedef ^ ParameterType ReKi PtchRate_Min - - - "Minimum pitch rate (most negative value allowed)" rad/s +typedef ^ ParameterType ReKi BlAlpha - - - "parameter for low-pass filter of blade pitch commands from the controller DLL" - +typedef ^ ParameterType IntKi DLL_n - - - "number of steps between the controller being called and SrvD being called" - +typedef ^ ParameterType IntKi avcOUTNAME_LEN - - - "Length of the avcOUTNAME character array passed to/from the DLL" - typedef ^ ParameterType ReKi NacYaw_North - - - "Reference yaw angle of the nacelle when the upwind end points due North" rad -typedef ^ ParameterType CHARACTER(1024) DLL_InFile - - - "Name of input file used in DLL" - -typedef ^ ParameterType DLL_Type DLL_Trgt - - - "The addresses and names of the Bladed DLL and its procedure" - -typedef ^ ParameterType TMD_ParameterType NTMD - - - "TMD module parameters - nacelle" - -typedef ^ ParameterType TMD_ParameterType TTMD - - - "TMD module parameters - tower" - typedef ^ ParameterType ReKi AvgWindSpeed - - - "average wind speed for the simulation" m/s typedef ^ ParameterType ReKi AirDens - - - "air density" kg/m^3 +# parameters for trim-case (linearization): +typedef ^ ParameterType IntKi TrimCase - - - "Controller parameter to be trimmed {1:yaw; 2:torque; 3:pitch} [used only if CalcSteady=True]" - +typedef ^ ParameterType ReKi TrimGain - - - "Proportional gain for the rotational speed error (>0) [used only if TrimCase>0]" "rad/(rad/s) for yaw or pitch; Nm/(rad/s) for torque" +typedef ^ ParameterType ReKi RotSpeedRef - - - "Reference rotor speed" "rad/s" +# parameters for other modules: +typedef ^ ParameterType TMD_ParameterType NTMD - - - "TMD module parameters - nacelle" - +typedef ^ ParameterType TMD_ParameterType TTMD - - - "TMD module parameters - tower" - # ..... Inputs .................................................................................................................... -# Define inputs that are contained on the mesh here: -#typedef ^ InputType MeshType MeshedInput - - - "Meshed input data" - # Define inputs that are not on this mesh here: -typedef ^ InputType ReKi BlPitch {:} - - "Current blade pitch angles" radians -typedef ^ InputType ReKi Yaw - - - "Current nacelle yaw" radians +typedef ^ InputType ReKi BlPitch {:} - 2pi "Current blade pitch angles" radians +typedef ^ InputType ReKi Yaw - - 2pi "Current nacelle yaw" radians typedef ^ InputType ReKi YawRate - - - "Current nacelle yaw rate" rad/s typedef ^ InputType ReKi LSS_Spd - - - "Low-speed shaft (LSS) speed at entrance to gearbox" rad/s typedef ^ InputType ReKi HSS_Spd - - - "High-speed shaft (HSS) speed" rad/s typedef ^ InputType ReKi RotSpeed - - - "Rotor azimuth angular speed" rad/s -typedef ^ InputType ReKi ExternalYawPosCom - - - "Commanded nacelle yaw position from Simulink or Labview" radians +typedef ^ InputType ReKi ExternalYawPosCom - - 2pi "Commanded nacelle yaw position from Simulink or Labview" radians typedef ^ InputType ReKi ExternalYawRateCom - - - "Commanded nacelle yaw rate from Simulink or Labview" rad/s -typedef ^ InputType ReKi ExternalBlPitchCom {:} - - "Commanded blade pitch from Simulink or LabVIEW" radians +typedef ^ InputType ReKi ExternalBlPitchCom {:} - 2pi "Commanded blade pitch from Simulink or LabVIEW" radians typedef ^ InputType ReKi ExternalGenTrq - - - "Electrical generator torque from Simulink or LabVIEW" N-m typedef ^ InputType ReKi ExternalElecPwr - - - "Electrical power from Simulink or LabVIEW" W typedef ^ InputType ReKi ExternalHSSBrFrac - - - "Fraction of full braking torque: 0 (off) <= HSSBrFrac <= 1 (full) from Simulink or LabVIEW" - typedef ^ InputType ReKi TwrAccel - - - "Tower acceleration for tower feedback control (user routine only)" m/s^2 -typedef ^ InputType ReKi YawErr - - - "Yaw error" radians -typedef ^ InputType ReKi WindDir - - - "Wind direction" radians +typedef ^ InputType ReKi YawErr - - 2pi "Yaw error" radians +typedef ^ InputType ReKi WindDir - - 2pi "Wind direction" radians typedef ^ InputType ReKi RootMyc 3 - - "Out-of-plane moment (i.e., the moment caused by out-of-plane forces) at the blade root for each of the blades (max 3)" N-m typedef ^ InputType ReKi YawBrTAxp - - - "Tower-top / yaw bearing fore-aft (translational) acceleration (absolute)" m/s^2 typedef ^ InputType ReKi YawBrTAyp - - - "Tower-top / yaw bearing side-to-side (translational) acceleration (absolute)" m/s^2 @@ -318,9 +371,7 @@ typedef ^ InputType ReKi NcIMURAys - - - "Nacelle inertial measurement unit angu typedef ^ InputType ReKi NcIMURAzs - - - "Nacelle inertial measurement unit angular (rotational) acceleration (absolute)" rad/s^2 typedef ^ InputType ReKi RotPwr - - - "Rotor power (this is equivalent to the low-speed shaft power)" W typedef ^ InputType ReKi HorWindV - - - "Horizontal hub-height wind velocity magnitude" m/s -typedef ^ InputType ReKi YawAngle - - - "Estimate of yaw (nacelle + platform)" radians -typedef ^ InputType ReKi ElecPwr_prev - - - "Electrical power (from previous step), sent to Bladed DLL" W -typedef ^ InputType ReKi GenTrq_prev - - - "Electrical generator torque (from previous step), sent to Bladed DLL" N-m +typedef ^ InputType ReKi YawAngle - - 2pi "Estimate of yaw (nacelle + platform)" radians typedef ^ InputType TMD_InputType NTMD - - - "TMD module inputs - nacelle" - typedef ^ InputType TMD_InputType TTMD - - - "TMD module inputs - tower" - typedef ^ InputType SiKi SuperController {:} - - "A swap array: used to pass input data to the DLL controller from the supercontroller" - @@ -330,7 +381,7 @@ typedef ^ InputType SiKi SuperController {:} - - "A swap array: used to pass inp #typedef ^ OutputType MeshType MeshedOutput - - - "Meshed output data" - # Define outputs that are not on this mesh here: typedef ^ OutputType ReKi WriteOutput {:} - - "Data to be written to an output file: see WriteOutputHdr for names of each variable" "see WriteOutputUnt" -typedef ^ OutputType ReKi BlPitchCom {:} - - "Commanded blade pitch angles" radians +typedef ^ OutputType ReKi BlPitchCom {:} - 2pi "Commanded blade pitch angles" radians typedef ^ OutputType ReKi BlAirfoilCom {:} - - "Commanded Airfoil UserProp for blade. Passed to AD15 for airfoil interpolation (must be same units as given in AD15 airfoil tables)" - typedef ^ OutputType ReKi YawMom - - - "Torque transmitted through the yaw bearing" N-m typedef ^ OutputType ReKi GenTrq - - - "Electrical generator torque" N-m diff --git a/modules/servodyn/src/ServoDyn_Types.f90 b/modules/servodyn/src/ServoDyn_Types.f90 index ea7a3519de..0b23dfb3b4 100644 --- a/modules/servodyn/src/ServoDyn_Types.f90 +++ b/modules/servodyn/src/ServoDyn_Types.f90 @@ -49,6 +49,9 @@ MODULE ServoDyn_Types REAL(ReKi) :: AirDens !< air density [kg/m^3] INTEGER(IntKi) :: NumSC2Ctrl !< number of controller inputs [from supercontroller] [-] INTEGER(IntKi) :: NumCtrl2SC !< number of controller outputs [to supercontroller] [-] + INTEGER(IntKi) :: TrimCase !< Controller parameter to be trimmed {1:yaw; 2:torque; 3:pitch} [used only if CalcSteady=True] [-] + REAL(ReKi) :: TrimGain !< Proportional gain for the rotational speed error (>0) [used only if TrimCase>0] [rad/(rad/s) for yaw or pitch; Nm/(rad/s) for torque] + REAL(ReKi) :: RotSpeedRef !< Reference rotor speed [rad/s] END TYPE SrvD_InitInputType ! ======================= ! ========= SrvD_InitOutputType ======= @@ -138,6 +141,7 @@ MODULE ServoDyn_Types INTEGER(IntKi) :: DLL_NumTrq !< Record 26: No. of points in torque-speed look-up table {0 = none and use the optimal mode PARAMETERs instead, nonzero = ignore the optimal mode PARAMETERs by setting Gain_OM (Record 16) to 0.0} [used only with DLL Interface] [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: GenSpd_TLU !< Records R:2:R+2*DLL_NumTrq-2: Generator speed values in look-up table [used only with DLL Interface] [rad/s] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: GenTrq_TLU !< Records R+1:2:R+2*DLL_NumTrq-1: Generator torque values in look-up table [used only with DLL Interface] [Nm] + LOGICAL :: UseLegacyInterface !< Flag that determines if the legacy Bladed interface is (legacy=DISCON with avrSWAP instead of CONTROLLER) [-] LOGICAL :: CompNTMD !< Compute nacelle tuned mass damper {true/false} [-] CHARACTER(1024) :: NTMDfile !< File for nacelle tuned mass damper (quoted string) [-] LOGICAL :: CompTTMD !< Compute tower tuned mass damper {true/false} [-] @@ -147,15 +151,73 @@ MODULE ServoDyn_Types ! ========= BladedDLLType ======= TYPE, PUBLIC :: BladedDLLType REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: avrSWAP !< The swap array: used to pass data to and from the DLL controller [see Bladed DLL documentation] - REAL(ReKi) :: HSSBrFrac !< Fraction of full braking torque: 0 (off) <= HSSBrFrac <= 1 (full) - from Bladed DLL [-] - REAL(ReKi) :: HSSBrTrqC !< Braking torque [N-m] + REAL(ReKi) :: HSSBrTrqDemand !< Demanded braking torque - from Bladed DLL [-] REAL(ReKi) :: YawRateCom !< Nacelle yaw rate demanded from Bladed DLL [rad/s] REAL(ReKi) :: GenTrq !< Electrical generator torque from Bladed DLL [N-m] - INTEGER(IntKi) :: GenState !< Generator state from Bladed DLL [N-m] + INTEGER(IntKi) :: GenState !< Generator state from Bladed DLL [-] REAL(ReKi) , DIMENSION(1:3) :: BlPitchCom !< Commanded blade pitch angles [radians] REAL(ReKi) , DIMENSION(1:3) :: PrevBlPitch !< Previously commanded blade pitch angles [radians] REAL(ReKi) , DIMENSION(1:3) :: BlAirfoilCom !< Commanded Airfoil UserProp for blade. Passed to AD15 for airfoil interpolation (must be same units as given in AD15 airfoil tables) [-] + REAL(ReKi) :: ElecPwr_prev !< Electrical power (from previous step), sent to Bladed DLL [W] + REAL(ReKi) :: GenTrq_prev !< Electrical generator torque (from previous step), sent to Bladed DLL [N-m] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: SCoutput !< controller output to supercontroller [-] + LOGICAL :: initialized !< flag that determines if DLL has been called (for difference between CalcOutput and UpdateStates) [-] + INTEGER(IntKi) :: NumLogChannels !< number of log channels from controller [-] + TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: LogChannels_OutParam !< Names and units (and other characteristics) of logging outputs from DLL [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: LogChannels !< logging outputs from controller [-] + INTEGER(IntKi) :: ErrStat !< error message from external controller API [-] + CHARACTER(ErrMsgLen) :: ErrMsg !< error message from external controller API [-] + REAL(R8Ki) :: CurrentTime !< Current Simulation Time [s] + INTEGER(IntKi) :: SimStatus !< simulation status (see avrSWAP(1): Status flag set as follows: 0 if this is the first call, 1 for all subsequent time steps, -1 if this is the final call at the end of the simulation) [-] + INTEGER(IntKi) :: ShaftBrakeStatusBinaryFlag !< binary flag indicating (on/off) status for shaft brake 1, shaft brake 2, generator brake, shaft brake 3, or brake torque set separately (0, 1, or 16 allowed in FAST) [-] + LOGICAL :: HSSBrDeployed !< Whether the HSS brake has been deployed [-] + REAL(R8Ki) :: TimeHSSBrFullyDeployed !< Time at which the controller high-speed shaft is fully deployed [s] + REAL(R8Ki) :: TimeHSSBrDeployed !< Time at which the controller high-speed shaft is first deployed [s] + LOGICAL :: OverrideYawRateWithTorque !< acts similiar to Yaw_Cntrl [-] + REAL(ReKi) :: YawTorqueDemand !< Demanded yaw actuator torque (override of yaw rate control) [Nm] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlPitchInput !< Input blade pitch angles [radians] + REAL(ReKi) :: YawAngleFromNorth !< Yaw angle of the nacelle relative to North (see NacYaw_North) [rad] + REAL(ReKi) :: HorWindV !< Horizontal hub-height wind velocity magnitude [m/s] + REAL(ReKi) :: HSS_Spd !< High-speed shaft (HSS) speed [rad/s] + REAL(ReKi) :: YawErr !< Yaw error [radians] + REAL(ReKi) :: RotSpeed !< Rotor azimuth angular speed [rad/s] + REAL(ReKi) :: YawBrTAxp !< Tower-top / yaw bearing fore-aft (translational) acceleration (absolute) [m/s^2] + REAL(ReKi) :: YawBrTAyp !< Tower-top / yaw bearing side-to-side (translational) acceleration (absolute) [m/s^2] + REAL(ReKi) :: LSSTipMys !< Nonrotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] + REAL(ReKi) :: LSSTipMzs !< Nonrotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] + REAL(ReKi) :: LSSTipMya !< Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] + REAL(ReKi) :: LSSTipMza !< Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] + REAL(ReKi) :: LSSTipPxa !< Rotor azimuth angle (position) [radians] + REAL(ReKi) :: Yaw !< Current nacelle yaw [radians] + REAL(ReKi) :: YawRate !< Current nacelle yaw rate [rad/s] + REAL(ReKi) :: YawBrMyn !< Rotating (with nacelle) tower-top / yaw bearing pitch moment [N-m] + REAL(ReKi) :: YawBrMzn !< Tower-top / yaw bearing yaw moment [N-m] + REAL(ReKi) :: NcIMURAxs !< Nacelle inertial measurement unit angular (rotational) acceleration (absolute) [rad/s^2] + REAL(ReKi) :: NcIMURAys !< Nacelle inertial measurement unit angular (rotational) acceleration (absolute) [rad/s^2] + REAL(ReKi) :: NcIMURAzs !< Nacelle inertial measurement unit angular (rotational) acceleration (absolute) [rad/s^2] + REAL(ReKi) :: RotPwr !< Rotor power (this is equivalent to the low-speed shaft power) [W] + REAL(ReKi) :: LSSTipMxa !< Rotating low-speed shaft bending moment at the shaft tip (teeter pin for 2-blader, apex of rotation for 3-blader) [N-m] + REAL(ReKi) , DIMENSION(1:3) :: RootMyc !< Out-of-plane moment (i.e., the moment caused by out-of-plane forces) at the blade root for each of the blades (max 3) [N-m] + REAL(ReKi) , DIMENSION(1:3) :: RootMxc !< In-plane moment (i.e., the moment caused by in-plane forces) at the blade root [N-m] + REAL(DbKi) :: DLL_DT !< interval for calling DLL (integer multiple number of DT) [s] + CHARACTER(1024) :: DLL_InFile !< Name of input file used in DLL [-] + CHARACTER(1024) :: RootName !< RootName for writing output files [-] + REAL(ReKi) :: GenTrq_Dem !< Demanded generator torque above rated [Nm] + REAL(ReKi) :: GenSpd_Dem !< Demanded generator speed above rated [rad/s] + REAL(ReKi) :: Ptch_Max !< Maximum pitch angle [rad] + REAL(ReKi) :: Ptch_Min !< Minimum pitch angle [rad] + REAL(ReKi) :: Ptch_SetPnt !< Below-rated pitch angle set-point [rad] + REAL(ReKi) :: PtchRate_Max !< Maximum pitch rate [rad/s] + REAL(ReKi) :: PtchRate_Min !< Minimum pitch rate (most negative value allowed) [rad/s] + REAL(ReKi) :: GenPwr_Dem !< Demanded power (This is not valid for variable-speed, pitch-regulated controllers.) [W] + REAL(ReKi) :: Gain_OM !< Optimal mode gain [Nm/(rad/s)^2] + REAL(ReKi) :: GenSpd_MaxOM !< Optimal mode maximum speed [rad/s] + REAL(ReKi) :: GenSpd_MinOM !< Minimum generator speed [rad/s] + INTEGER(IntKi) :: Ptch_Cntrl !< Pitch control: 0 = collective; 1 = individual [-] + INTEGER(IntKi) :: DLL_NumTrq !< No. of points in torque-speed look-up table, 0 = none and use the optimal mode PARAMETERs instead; nonzero = ignore the optimal mode PARAMETERs by setting Record 16 to 0.0 [-] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: GenSpd_TLU !< Table (array) containing DLL_NumTrq generator speeds for the torque-speed table look-up (TLU) -- this should be defined using an array constructor; for example, if DLL_NumTrq = 3, GenSpd_TLU(DLL_NumTrq) = (/ 0.0, 99.9, 999.9 /) [rad/s] + REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: GenTrq_TLU !< Table (array) containing DLL_NumTrq generator torques for the torque-speed table look-up (TLU) -- this should be defined using an array constructor, for example, if DLL_NumTrq = 3, GenTrq_TLU(DLL_NumTrq) = (/ 0.0, 10, 200.0 /) [Nm] + INTEGER(IntKi) :: Yaw_Cntrl !< Yaw control: 0 = rate; 1 = torque [-] END TYPE BladedDLLType ! ======================= ! ========= SrvD_ContinuousStateType ======= @@ -167,6 +229,7 @@ MODULE ServoDyn_Types ! ======================= ! ========= SrvD_DiscreteStateType ======= TYPE, PUBLIC :: SrvD_DiscreteStateType + REAL(ReKi) :: CtrlOffset !< Controller offset parameter [N-m] TYPE(TMD_DiscreteStateType) :: NTMD !< TMD module states - nacelle [-] TYPE(TMD_DiscreteStateType) :: TTMD !< TMD module states - tower [-] END TYPE SrvD_DiscreteStateType @@ -211,7 +274,6 @@ MODULE ServoDyn_Types TYPE, PUBLIC :: SrvD_ParameterType REAL(DbKi) :: DT !< Time step for continuous state integration & discrete state update [seconds] REAL(DbKi) :: HSSBrDT !< Time it takes for HSS brake to reach full deployment once deployed [seconds] - REAL(ReKi) :: HSSBrFrac !< Fraction of full braking torque: 0 (off) <= HSSBrFrac <= 1 (full), (-) [-] REAL(ReKi) :: HSSBrTqF !< Fully deployed HSS brake torque [-] REAL(ReKi) :: SIG_POSl !< Pullout slip [-] REAL(ReKi) :: SIG_POTq !< Pullout torque [-] @@ -236,7 +298,6 @@ MODULE ServoDyn_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlPitchInit !< Initial blade pitch angles [radians] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: BlPitchF !< Final blade pitch [-] REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: PitManRat !< Pitch rates at which override pitch maneuvers head toward final pitch angles (does not include sign) [rad/s] - REAL(ReKi) :: BlAlpha REAL(ReKi) :: YawManRat !< Yaw rate at which override yaw maneuver head toward for final yaw angle (does not include sign) [rad/s] REAL(ReKi) :: NacYawF !< Final yaw angle after override yaw maneuver [-] REAL(ReKi) :: SpdGenOn !< Generator speed to turn on the generator for a startup [-] @@ -275,34 +336,25 @@ MODULE ServoDyn_Types LOGICAL :: CompNTMD !< Compute nacelle tuned mass damper {true/false} [-] LOGICAL :: CompTTMD !< Compute tower tuned mass damper {true/false} [-] INTEGER(IntKi) :: NumOuts !< Number of parameters in the output list (number of outputs requested) [-] + INTEGER(IntKi) :: NumOuts_DLL !< Number of logging channels output from the DLL (set at initialization) [-] CHARACTER(1024) :: RootName !< RootName for writing output files [-] TYPE(OutParmType) , DIMENSION(:), ALLOCATABLE :: OutParam !< Names and units (and other characteristics) of all requested output parameters [-] CHARACTER(1) :: Delim !< Column delimiter for output text files [-] LOGICAL :: UseBladedInterface !< Flag that determines if BladedInterface was used [-] + LOGICAL :: UseLegacyInterface !< Flag that determines if the legacy Bladed interface is (legacy=DISCON with avrSWAP instead of CONTROLLER) [-] + TYPE(DLL_Type) :: DLL_Trgt !< The addresses and names of the Bladed DLL and its procedure [-] LOGICAL :: DLL_Ramp !< determines if there is a DLL_DT-ramp time delay (true only when DLL_DT /= DT) [-] - REAL(DbKi) :: DLL_DT !< interval for calling DLL (integer multiple number of DT) [s] - INTEGER(IntKi) :: DLL_NumTrq !< No. of points in torque-speed look-up table, 0 = none and use the optimal mode PARAMETERs instead; nonzero = ignore the optimal mode PARAMETERs by setting Record 16 to 0.0 [-] - INTEGER(IntKi) :: Ptch_Cntrl !< Pitch control: 0 = collective; 1 = individual [-] - REAL(ReKi) :: Gain_OM !< Optimal mode gain [Nm/(rad/s)^2] - REAL(ReKi) :: GenPwr_Dem !< Demanded power [W] - REAL(ReKi) :: GenSpd_Dem !< Demanded generator speed above rated [rad/s] - REAL(ReKi) :: GenSpd_MaxOM !< Optimal mode maximum speed [rad/s] - REAL(ReKi) :: GenSpd_MinOM !< Minimum generator speed [rad/s] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: GenSpd_TLU !< Table (array) containing DLL_NumTrq generator speeds for the torque-speed table look-up (TLU) -- this should be defined using an array constructor; for example, if DLL_NumTrq = 3, GenSpd_TLU(DLL_NumTrq) = (/ 0.0, 99.9, 999.9 /) [rad/s] - REAL(ReKi) :: GenTrq_Dem !< Demanded generator torque [Nm] - REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: GenTrq_TLU !< Table (array) containing DLL_NumTrq generator torques for the torque-speed table look-up (TLU) -- this should be defined using an array constructor, for example, if DLL_NumTrq = 3, GenTrq_TLU(DLL_NumTrq) = (/ 0.0, 10, 200.0 /) [Nm] - REAL(ReKi) :: Ptch_Max !< Maximum pitch angle [rad] - REAL(ReKi) :: Ptch_Min !< Minimum pitch angle [rad] - REAL(ReKi) :: Ptch_SetPnt !< Below-rated pitch angle set-point [rad] - REAL(ReKi) :: PtchRate_Max !< Maximum pitch rate [rad/s] - REAL(ReKi) :: PtchRate_Min !< Minimum pitch rate (most negative value allowed) [rad/s] + REAL(ReKi) :: BlAlpha !< parameter for low-pass filter of blade pitch commands from the controller DLL [-] + INTEGER(IntKi) :: DLL_n !< number of steps between the controller being called and SrvD being called [-] + INTEGER(IntKi) :: avcOUTNAME_LEN !< Length of the avcOUTNAME character array passed to/from the DLL [-] REAL(ReKi) :: NacYaw_North !< Reference yaw angle of the nacelle when the upwind end points due North [rad] - CHARACTER(1024) :: DLL_InFile !< Name of input file used in DLL [-] - TYPE(DLL_Type) :: DLL_Trgt !< The addresses and names of the Bladed DLL and its procedure [-] - TYPE(TMD_ParameterType) :: NTMD !< TMD module parameters - nacelle [-] - TYPE(TMD_ParameterType) :: TTMD !< TMD module parameters - tower [-] REAL(ReKi) :: AvgWindSpeed !< average wind speed for the simulation [m/s] REAL(ReKi) :: AirDens !< air density [kg/m^3] + INTEGER(IntKi) :: TrimCase !< Controller parameter to be trimmed {1:yaw; 2:torque; 3:pitch} [used only if CalcSteady=True] [-] + REAL(ReKi) :: TrimGain !< Proportional gain for the rotational speed error (>0) [used only if TrimCase>0] [rad/(rad/s) for yaw or pitch; Nm/(rad/s) for torque] + REAL(ReKi) :: RotSpeedRef !< Reference rotor speed [rad/s] + TYPE(TMD_ParameterType) :: NTMD !< TMD module parameters - nacelle [-] + TYPE(TMD_ParameterType) :: TTMD !< TMD module parameters - tower [-] END TYPE SrvD_ParameterType ! ======================= ! ========= SrvD_InputType ======= @@ -340,8 +392,6 @@ MODULE ServoDyn_Types REAL(ReKi) :: RotPwr !< Rotor power (this is equivalent to the low-speed shaft power) [W] REAL(ReKi) :: HorWindV !< Horizontal hub-height wind velocity magnitude [m/s] REAL(ReKi) :: YawAngle !< Estimate of yaw (nacelle + platform) [radians] - REAL(ReKi) :: ElecPwr_prev !< Electrical power (from previous step), sent to Bladed DLL [W] - REAL(ReKi) :: GenTrq_prev !< Electrical generator torque (from previous step), sent to Bladed DLL [N-m] TYPE(TMD_InputType) :: NTMD !< TMD module inputs - nacelle [-] TYPE(TMD_InputType) :: TTMD !< TMD module inputs - tower [-] REAL(SiKi) , DIMENSION(:), ALLOCATABLE :: SuperController !< A swap array: used to pass input data to the DLL controller from the supercontroller [-] @@ -402,6 +452,9 @@ SUBROUTINE SrvD_CopyInitInput( SrcInitInputData, DstInitInputData, CtrlCode, Err DstInitInputData%AirDens = SrcInitInputData%AirDens DstInitInputData%NumSC2Ctrl = SrcInitInputData%NumSC2Ctrl DstInitInputData%NumCtrl2SC = SrcInitInputData%NumCtrl2SC + DstInitInputData%TrimCase = SrcInitInputData%TrimCase + DstInitInputData%TrimGain = SrcInitInputData%TrimGain + DstInitInputData%RotSpeedRef = SrcInitInputData%RotSpeedRef END SUBROUTINE SrvD_CopyInitInput SUBROUTINE SrvD_DestroyInitInput( InitInputData, ErrStat, ErrMsg ) @@ -470,6 +523,9 @@ SUBROUTINE SrvD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Re_BufSz = Re_BufSz + 1 ! AirDens Int_BufSz = Int_BufSz + 1 ! NumSC2Ctrl Int_BufSz = Int_BufSz + 1 ! NumCtrl2SC + Int_BufSz = Int_BufSz + 1 ! TrimCase + Re_BufSz = Re_BufSz + 1 ! TrimGain + Re_BufSz = Re_BufSz + 1 ! RotSpeedRef IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -497,18 +553,18 @@ SUBROUTINE SrvD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Linearize , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumBl - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(InData%InputFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%Linearize, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumBl + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( .NOT. ALLOCATED(InData%BlPitchInit) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -519,25 +575,37 @@ SUBROUTINE SrvD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlPitchInit,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BlPitchInit)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlPitchInit))-1 ) = PACK(InData%BlPitchInit,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlPitchInit) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%r_N_O_G))-1 ) = PACK(InData%r_N_O_G,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%r_N_O_G) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%r_TwrBase))-1 ) = PACK(InData%r_TwrBase,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%r_TwrBase) - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%Tmax - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AvgWindSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AirDens - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumSC2Ctrl - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumCtrl2SC - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%BlPitchInit,1), UBOUND(InData%BlPitchInit,1) + ReKiBuf(Re_Xferred) = InData%BlPitchInit(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%Gravity + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%r_N_O_G,1), UBOUND(InData%r_N_O_G,1) + ReKiBuf(Re_Xferred) = InData%r_N_O_G(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%r_TwrBase,1), UBOUND(InData%r_TwrBase,1) + ReKiBuf(Re_Xferred) = InData%r_TwrBase(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DbKiBuf(Db_Xferred) = InData%Tmax + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AvgWindSpeed + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AirDens + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumSC2Ctrl + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumCtrl2SC + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TrimCase + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TrimGain + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RotSpeedRef + Re_Xferred = Re_Xferred + 1 END SUBROUTINE SrvD_PackInitInput SUBROUTINE SrvD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -553,12 +621,6 @@ SUBROUTINE SrvD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -573,18 +635,18 @@ SUBROUTINE SrvD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%InputFile) - OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%Linearize = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NumBl = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%InputFile) + OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%Linearize = TRANSFER(IntKiBuf(Int_Xferred), OutData%Linearize) + Int_Xferred = Int_Xferred + 1 + OutData%NumBl = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlPitchInit not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -598,50 +660,41 @@ SUBROUTINE SrvD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitchInit.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BlPitchInit)>0) OutData%BlPitchInit = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlPitchInit))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlPitchInit) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BlPitchInit,1), UBOUND(OutData%BlPitchInit,1) + OutData%BlPitchInit(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%Gravity = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%Gravity = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%r_N_O_G,1) i1_u = UBOUND(OutData%r_N_O_G,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%r_N_O_G = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%r_N_O_G))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%r_N_O_G) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%r_N_O_G,1), UBOUND(OutData%r_N_O_G,1) + OutData%r_N_O_G(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%r_TwrBase,1) i1_u = UBOUND(OutData%r_TwrBase,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%r_TwrBase = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%r_TwrBase))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%r_TwrBase) - DEALLOCATE(mask1) - OutData%Tmax = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%AvgWindSpeed = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%AirDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NumSC2Ctrl = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumCtrl2SC = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%r_TwrBase,1), UBOUND(OutData%r_TwrBase,1) + OutData%r_TwrBase(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%Tmax = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%AvgWindSpeed = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%AirDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NumSC2Ctrl = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumCtrl2SC = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TrimCase = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TrimGain = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RotSpeedRef = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE SrvD_UnPackInitInput SUBROUTINE SrvD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -910,12 +963,12 @@ SUBROUTINE SrvD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -927,12 +980,12 @@ SUBROUTINE SrvD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + 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) @@ -962,10 +1015,10 @@ SUBROUTINE SrvD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%CouplingScheme - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%UseHSSBrake , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%CouplingScheme + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%UseHSSBrake, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%LinNames_y) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -976,12 +1029,12 @@ SUBROUTINE SrvD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_y,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%LinNames_y,1), UBOUND(InData%LinNames_y,1) + DO 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%LinNames_u) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -993,12 +1046,12 @@ SUBROUTINE SrvD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LinNames_u,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%LinNames_u,1), UBOUND(InData%LinNames_u,1) + DO 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%RotFrame_y) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1010,8 +1063,10 @@ SUBROUTINE SrvD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_y,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RotFrame_y)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%RotFrame_y)-1 ) = TRANSFER(PACK( InData%RotFrame_y ,.TRUE.), IntKiBuf(1), SIZE(InData%RotFrame_y)) - Int_Xferred = Int_Xferred + SIZE(InData%RotFrame_y) + DO i1 = LBOUND(InData%RotFrame_y,1), UBOUND(InData%RotFrame_y,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%RotFrame_y(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%RotFrame_u) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1023,8 +1078,10 @@ SUBROUTINE SrvD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%RotFrame_u,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%RotFrame_u)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%RotFrame_u)-1 ) = TRANSFER(PACK( InData%RotFrame_u ,.TRUE.), IntKiBuf(1), SIZE(InData%RotFrame_u)) - Int_Xferred = Int_Xferred + SIZE(InData%RotFrame_u) + 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 @@ -1036,8 +1093,10 @@ SUBROUTINE SrvD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IsLoad_u,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%IsLoad_u)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%IsLoad_u)-1 ) = TRANSFER(PACK( InData%IsLoad_u ,.TRUE.), IntKiBuf(1), SIZE(InData%IsLoad_u)) - Int_Xferred = Int_Xferred + SIZE(InData%IsLoad_u) + DO i1 = LBOUND(InData%IsLoad_u,1), UBOUND(InData%IsLoad_u,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%IsLoad_u(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF END SUBROUTINE SrvD_PackInitOutput @@ -1054,12 +1113,6 @@ SUBROUTINE SrvD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1087,19 +1140,12 @@ SUBROUTINE SrvD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated Int_Xferred = Int_Xferred + 1 @@ -1114,19 +1160,12 @@ SUBROUTINE SrvD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -1168,10 +1207,10 @@ SUBROUTINE SrvD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%CouplingScheme = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%UseHSSBrake = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%CouplingScheme = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%UseHSSBrake = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseHSSBrake) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_y not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1185,19 +1224,12 @@ SUBROUTINE SrvD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_y.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%LinNames_y,1), UBOUND(OutData%LinNames_y,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LinNames_u not allocated Int_Xferred = Int_Xferred + 1 @@ -1212,19 +1244,12 @@ SUBROUTINE SrvD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LinNames_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%LinNames_u,1), UBOUND(OutData%LinNames_u,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_y not allocated Int_Xferred = Int_Xferred + 1 @@ -1239,15 +1264,10 @@ SUBROUTINE SrvD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_y.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%RotFrame_y)>0) OutData%RotFrame_y = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%RotFrame_y))-1 ), OutData%RotFrame_y), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%RotFrame_y) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%RotFrame_y,1), UBOUND(OutData%RotFrame_y,1) + OutData%RotFrame_y(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%RotFrame_y(i1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! RotFrame_u not allocated Int_Xferred = Int_Xferred + 1 @@ -1262,15 +1282,10 @@ SUBROUTINE SrvD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%RotFrame_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%RotFrame_u)>0) OutData%RotFrame_u = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%RotFrame_u))-1 ), OutData%RotFrame_u), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%RotFrame_u) - DEALLOCATE(mask1) + 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 @@ -1285,15 +1300,10 @@ SUBROUTINE SrvD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IsLoad_u.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%IsLoad_u)>0) OutData%IsLoad_u = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%IsLoad_u))-1 ), OutData%IsLoad_u), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%IsLoad_u) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%IsLoad_u,1), UBOUND(OutData%IsLoad_u,1) + OutData%IsLoad_u(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%IsLoad_u(i1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF END SUBROUTINE SrvD_UnPackInitOutput @@ -1416,6 +1426,7 @@ SUBROUTINE SrvD_CopyInputFile( SrcInputFileData, DstInputFileData, CtrlCode, Err END IF DstInputFileData%GenTrq_TLU = SrcInputFileData%GenTrq_TLU ENDIF + DstInputFileData%UseLegacyInterface = SrcInputFileData%UseLegacyInterface DstInputFileData%CompNTMD = SrcInputFileData%CompNTMD DstInputFileData%NTMDfile = SrcInputFileData%NTMDfile DstInputFileData%CompTTMD = SrcInputFileData%CompTTMD @@ -1560,6 +1571,7 @@ SUBROUTINE SrvD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Int_BufSz = Int_BufSz + 2*1 ! GenTrq_TLU upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%GenTrq_TLU) ! GenTrq_TLU END IF + Int_BufSz = Int_BufSz + 1 ! UseLegacyInterface Int_BufSz = Int_BufSz + 1 ! CompNTMD Int_BufSz = Int_BufSz + 1*LEN(InData%NTMDfile) ! NTMDfile Int_BufSz = Int_BufSz + 1 ! CompTTMD @@ -1591,104 +1603,110 @@ SUBROUTINE SrvD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%PCMode - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%TPCOn - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%TPitManS))-1 ) = PACK(InData%TPitManS,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%TPitManS) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PitManRat))-1 ) = PACK(InData%PitManRat,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PitManRat) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlPitchF))-1 ) = PACK(InData%BlPitchF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlPitchF) - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%VSContrl - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%GenModel - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GenEff - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%GenTiStr , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%GenTiStp , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SpdGenOn - Re_Xferred = Re_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%TimGenOn - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%TimGenOf - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%VS_RtGnSp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%VS_RtTq - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%VS_Rgn2K - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%VS_SlPc - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SIG_SlPc - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SIG_SySp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SIG_RtTq - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SIG_PORt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TEC_Freq - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TEC_NPol - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TEC_SRes - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TEC_RRes - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TEC_VLL - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TEC_SLR - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TEC_RLR - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TEC_MR - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%HSSBrMode - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%THSSBrDp - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%HSSBrDT - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HSSBrTqF - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%YCMode - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%TYCOn - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawNeut - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawDamp - Re_Xferred = Re_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%TYawManS - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawManRat - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NacYawF - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%SumPrint , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%OutFile - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TabDelim , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%OutFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%Tstart - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%PCMode + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%TPCOn + Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(InData%TPitManS,1), UBOUND(InData%TPitManS,1) + DbKiBuf(Db_Xferred) = InData%TPitManS(i1) + Db_Xferred = Db_Xferred + 1 + END DO + DO i1 = LBOUND(InData%PitManRat,1), UBOUND(InData%PitManRat,1) + ReKiBuf(Re_Xferred) = InData%PitManRat(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%BlPitchF,1), UBOUND(InData%BlPitchF,1) + ReKiBuf(Re_Xferred) = InData%BlPitchF(i1) + Re_Xferred = Re_Xferred + 1 + END DO + IntKiBuf(Int_Xferred) = InData%VSContrl + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%GenModel + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GenEff + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%GenTiStr, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%GenTiStp, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SpdGenOn + Re_Xferred = Re_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%TimGenOn + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%TimGenOf + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VS_RtGnSp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VS_RtTq + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VS_Rgn2K + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VS_SlPc + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SIG_SlPc + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SIG_SySp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SIG_RtTq + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SIG_PORt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TEC_Freq + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TEC_NPol + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TEC_SRes + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TEC_RRes + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TEC_VLL + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TEC_SLR + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TEC_RLR + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TEC_MR + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%HSSBrMode + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%THSSBrDp + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%HSSBrDT + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HSSBrTqF + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%YCMode + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%TYCOn + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawNeut + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawSpr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawDamp + Re_Xferred = Re_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%TYawManS + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawManRat + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NacYawF + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%SumPrint, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%OutFile + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TabDelim, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%OutFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DbKiBuf(Db_Xferred) = InData%Tstart + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%OutList) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1699,59 +1717,59 @@ SUBROUTINE SrvD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OutList,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) + DO i1 = LBOUND(InData%OutList,1), UBOUND(InData%OutList,1) DO I = 1, LEN(InData%OutList) IntKiBuf(Int_Xferred) = ICHAR(InData%OutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF - DO I = 1, LEN(InData%DLL_FileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_FileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%DLL_ProcName) - IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_ProcName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%DLL_InFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_InFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DLL_DT - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%DLL_Ramp , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%BPCutoff - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NacYaw_North - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Ptch_Cntrl - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Ptch_SetPnt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Ptch_Min - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Ptch_Max - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtchRate_Min - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtchRate_Max - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Gain_OM - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GenSpd_MinOM - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GenSpd_MaxOM - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GenSpd_Dem - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GenTrq_Dem - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GenPwr_Dem - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DLL_NumTrq - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%DLL_FileName) + IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_FileName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%DLL_ProcName) + IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_ProcName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%DLL_InFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_InFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DbKiBuf(Db_Xferred) = InData%DLL_DT + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%DLL_Ramp, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%BPCutoff + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NacYaw_North + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Ptch_Cntrl + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Ptch_SetPnt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Ptch_Min + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Ptch_Max + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtchRate_Min + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtchRate_Max + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Gain_OM + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GenSpd_MinOM + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GenSpd_MaxOM + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GenSpd_Dem + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GenTrq_Dem + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GenPwr_Dem + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DLL_NumTrq + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%GenSpd_TLU) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1762,8 +1780,10 @@ SUBROUTINE SrvD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GenSpd_TLU,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%GenSpd_TLU)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GenSpd_TLU))-1 ) = PACK(InData%GenSpd_TLU,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GenSpd_TLU) + DO i1 = LBOUND(InData%GenSpd_TLU,1), UBOUND(InData%GenSpd_TLU,1) + ReKiBuf(Re_Xferred) = InData%GenSpd_TLU(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%GenTrq_TLU) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1775,21 +1795,25 @@ SUBROUTINE SrvD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GenTrq_TLU,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%GenTrq_TLU)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GenTrq_TLU))-1 ) = PACK(InData%GenTrq_TLU,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GenTrq_TLU) + DO i1 = LBOUND(InData%GenTrq_TLU,1), UBOUND(InData%GenTrq_TLU,1) + ReKiBuf(Re_Xferred) = InData%GenTrq_TLU(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%CompNTMD , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%NTMDfile) - IntKiBuf(Int_Xferred) = ICHAR(InData%NTMDfile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%CompTTMD , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%TTMDfile) - IntKiBuf(Int_Xferred) = ICHAR(InData%TTMDfile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%UseLegacyInterface, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%CompNTMD, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%NTMDfile) + IntKiBuf(Int_Xferred) = ICHAR(InData%NTMDfile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%CompTTMD, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%TTMDfile) + IntKiBuf(Int_Xferred) = ICHAR(InData%TTMDfile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE SrvD_PackInputFile SUBROUTINE SrvD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1805,12 +1829,6 @@ SUBROUTINE SrvD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1825,131 +1843,116 @@ SUBROUTINE SrvD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%PCMode = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TPCOn = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%PCMode = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TPCOn = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 i1_l = LBOUND(OutData%TPitManS,1) i1_u = UBOUND(OutData%TPitManS,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%TPitManS = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%TPitManS))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%TPitManS) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TPitManS,1), UBOUND(OutData%TPitManS,1) + OutData%TPitManS(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO i1_l = LBOUND(OutData%PitManRat,1) i1_u = UBOUND(OutData%PitManRat,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%PitManRat = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PitManRat))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PitManRat) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%PitManRat,1), UBOUND(OutData%PitManRat,1) + OutData%PitManRat(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%BlPitchF,1) i1_u = UBOUND(OutData%BlPitchF,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%BlPitchF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlPitchF))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlPitchF) - DEALLOCATE(mask1) - OutData%VSContrl = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%GenModel = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%GenEff = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GenTiStr = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%GenTiStp = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%SpdGenOn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TimGenOn = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%TimGenOf = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%VS_RtGnSp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%VS_RtTq = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%VS_Rgn2K = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%VS_SlPc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SIG_SlPc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SIG_SySp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SIG_RtTq = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SIG_PORt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_Freq = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_NPol = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TEC_SRes = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_RRes = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_VLL = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_SLR = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_RLR = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_MR = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HSSBrMode = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%THSSBrDp = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%HSSBrDT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%HSSBrTqF = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YCMode = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TYCOn = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%YawNeut = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawSpr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawDamp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TYawManS = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%YawManRat = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NacYawF = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SumPrint = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%OutFile = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TabDelim = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%OutFmt) - OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%Tstart = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%BlPitchF,1), UBOUND(OutData%BlPitchF,1) + OutData%BlPitchF(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%VSContrl = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%GenModel = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%GenEff = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GenTiStr = TRANSFER(IntKiBuf(Int_Xferred), OutData%GenTiStr) + Int_Xferred = Int_Xferred + 1 + OutData%GenTiStp = TRANSFER(IntKiBuf(Int_Xferred), OutData%GenTiStp) + Int_Xferred = Int_Xferred + 1 + OutData%SpdGenOn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TimGenOn = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%TimGenOf = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%VS_RtGnSp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%VS_RtTq = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%VS_Rgn2K = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%VS_SlPc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SIG_SlPc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SIG_SySp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SIG_RtTq = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SIG_PORt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TEC_Freq = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TEC_NPol = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TEC_SRes = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TEC_RRes = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TEC_VLL = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TEC_SLR = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TEC_RLR = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TEC_MR = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HSSBrMode = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%THSSBrDp = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%HSSBrDT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%HSSBrTqF = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YCMode = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TYCOn = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%YawNeut = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawSpr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawDamp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TYawManS = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%YawManRat = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NacYawF = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SumPrint = TRANSFER(IntKiBuf(Int_Xferred), OutData%SumPrint) + Int_Xferred = Int_Xferred + 1 + OutData%OutFile = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TabDelim = TRANSFER(IntKiBuf(Int_Xferred), OutData%TabDelim) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%OutFmt) + OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%Tstart = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutList not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1963,66 +1966,59 @@ SUBROUTINE SrvD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OutList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) + DO i1 = LBOUND(OutData%OutList,1), UBOUND(OutData%OutList,1) DO I = 1, LEN(OutData%OutList) OutData%OutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) - END IF - DO I = 1, LEN(OutData%DLL_FileName) - OutData%DLL_FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%DLL_ProcName) - OutData%DLL_ProcName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%DLL_InFile) - OutData%DLL_InFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%DLL_DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%DLL_Ramp = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%BPCutoff = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NacYaw_North = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Ptch_Cntrl = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%Ptch_SetPnt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Ptch_Min = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Ptch_Max = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtchRate_Min = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtchRate_Max = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Gain_OM = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GenSpd_MinOM = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GenSpd_MaxOM = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GenSpd_Dem = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GenTrq_Dem = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GenPwr_Dem = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%DLL_NumTrq = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + END DO + END IF + DO I = 1, LEN(OutData%DLL_FileName) + OutData%DLL_FileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%DLL_ProcName) + OutData%DLL_ProcName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%DLL_InFile) + OutData%DLL_InFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%DLL_DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%DLL_Ramp = TRANSFER(IntKiBuf(Int_Xferred), OutData%DLL_Ramp) + Int_Xferred = Int_Xferred + 1 + OutData%BPCutoff = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NacYaw_North = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Ptch_Cntrl = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%Ptch_SetPnt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Ptch_Min = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Ptch_Max = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtchRate_Min = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtchRate_Max = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Gain_OM = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GenSpd_MinOM = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GenSpd_MaxOM = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GenSpd_Dem = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GenTrq_Dem = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GenPwr_Dem = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%DLL_NumTrq = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GenSpd_TLU not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -2036,15 +2032,10 @@ SUBROUTINE SrvD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GenSpd_TLU.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%GenSpd_TLU)>0) OutData%GenSpd_TLU = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GenSpd_TLU))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GenSpd_TLU) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%GenSpd_TLU,1), UBOUND(OutData%GenSpd_TLU,1) + OutData%GenSpd_TLU(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GenTrq_TLU not allocated Int_Xferred = Int_Xferred + 1 @@ -2059,28 +2050,25 @@ SUBROUTINE SrvD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GenTrq_TLU.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%GenTrq_TLU)>0) OutData%GenTrq_TLU = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GenTrq_TLU))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GenTrq_TLU) - DEALLOCATE(mask1) - END IF - OutData%CompNTMD = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%NTMDfile) - OutData%NTMDfile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%CompTTMD = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%TTMDfile) - OutData%TTMDfile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO i1 = LBOUND(OutData%GenTrq_TLU,1), UBOUND(OutData%GenTrq_TLU,1) + OutData%GenTrq_TLU(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%UseLegacyInterface = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseLegacyInterface) + Int_Xferred = Int_Xferred + 1 + OutData%CompNTMD = TRANSFER(IntKiBuf(Int_Xferred), OutData%CompNTMD) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%NTMDfile) + OutData%NTMDfile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%CompTTMD = TRANSFER(IntKiBuf(Int_Xferred), OutData%CompTTMD) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%TTMDfile) + OutData%TTMDfile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I END SUBROUTINE SrvD_UnPackInputFile SUBROUTINE SrvD_CopyBladedDLLType( SrcBladedDLLTypeData, DstBladedDLLTypeData, CtrlCode, ErrStat, ErrMsg ) @@ -2110,14 +2098,15 @@ SUBROUTINE SrvD_CopyBladedDLLType( SrcBladedDLLTypeData, DstBladedDLLTypeData, C END IF DstBladedDLLTypeData%avrSWAP = SrcBladedDLLTypeData%avrSWAP ENDIF - DstBladedDLLTypeData%HSSBrFrac = SrcBladedDLLTypeData%HSSBrFrac - DstBladedDLLTypeData%HSSBrTrqC = SrcBladedDLLTypeData%HSSBrTrqC + DstBladedDLLTypeData%HSSBrTrqDemand = SrcBladedDLLTypeData%HSSBrTrqDemand DstBladedDLLTypeData%YawRateCom = SrcBladedDLLTypeData%YawRateCom DstBladedDLLTypeData%GenTrq = SrcBladedDLLTypeData%GenTrq DstBladedDLLTypeData%GenState = SrcBladedDLLTypeData%GenState DstBladedDLLTypeData%BlPitchCom = SrcBladedDLLTypeData%BlPitchCom DstBladedDLLTypeData%PrevBlPitch = SrcBladedDLLTypeData%PrevBlPitch DstBladedDLLTypeData%BlAirfoilCom = SrcBladedDLLTypeData%BlAirfoilCom + DstBladedDLLTypeData%ElecPwr_prev = SrcBladedDLLTypeData%ElecPwr_prev + DstBladedDLLTypeData%GenTrq_prev = SrcBladedDLLTypeData%GenTrq_prev IF (ALLOCATED(SrcBladedDLLTypeData%SCoutput)) THEN i1_l = LBOUND(SrcBladedDLLTypeData%SCoutput,1) i1_u = UBOUND(SrcBladedDLLTypeData%SCoutput,1) @@ -2130,6 +2119,122 @@ SUBROUTINE SrvD_CopyBladedDLLType( SrcBladedDLLTypeData, DstBladedDLLTypeData, C END IF DstBladedDLLTypeData%SCoutput = SrcBladedDLLTypeData%SCoutput ENDIF + DstBladedDLLTypeData%initialized = SrcBladedDLLTypeData%initialized + DstBladedDLLTypeData%NumLogChannels = SrcBladedDLLTypeData%NumLogChannels +IF (ALLOCATED(SrcBladedDLLTypeData%LogChannels_OutParam)) THEN + i1_l = LBOUND(SrcBladedDLLTypeData%LogChannels_OutParam,1) + i1_u = UBOUND(SrcBladedDLLTypeData%LogChannels_OutParam,1) + IF (.NOT. ALLOCATED(DstBladedDLLTypeData%LogChannels_OutParam)) THEN + ALLOCATE(DstBladedDLLTypeData%LogChannels_OutParam(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%LogChannels_OutParam.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DO i1 = LBOUND(SrcBladedDLLTypeData%LogChannels_OutParam,1), UBOUND(SrcBladedDLLTypeData%LogChannels_OutParam,1) + CALL NWTC_Library_Copyoutparmtype( SrcBladedDLLTypeData%LogChannels_OutParam(i1), DstBladedDLLTypeData%LogChannels_OutParam(i1), CtrlCode, ErrStat2, ErrMsg2 ) + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) + IF (ErrStat>=AbortErrLev) RETURN + ENDDO +ENDIF +IF (ALLOCATED(SrcBladedDLLTypeData%LogChannels)) THEN + i1_l = LBOUND(SrcBladedDLLTypeData%LogChannels,1) + i1_u = UBOUND(SrcBladedDLLTypeData%LogChannels,1) + IF (.NOT. ALLOCATED(DstBladedDLLTypeData%LogChannels)) THEN + ALLOCATE(DstBladedDLLTypeData%LogChannels(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%LogChannels.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstBladedDLLTypeData%LogChannels = SrcBladedDLLTypeData%LogChannels +ENDIF + DstBladedDLLTypeData%ErrStat = SrcBladedDLLTypeData%ErrStat + DstBladedDLLTypeData%ErrMsg = SrcBladedDLLTypeData%ErrMsg + DstBladedDLLTypeData%CurrentTime = SrcBladedDLLTypeData%CurrentTime + DstBladedDLLTypeData%SimStatus = SrcBladedDLLTypeData%SimStatus + DstBladedDLLTypeData%ShaftBrakeStatusBinaryFlag = SrcBladedDLLTypeData%ShaftBrakeStatusBinaryFlag + DstBladedDLLTypeData%HSSBrDeployed = SrcBladedDLLTypeData%HSSBrDeployed + DstBladedDLLTypeData%TimeHSSBrFullyDeployed = SrcBladedDLLTypeData%TimeHSSBrFullyDeployed + DstBladedDLLTypeData%TimeHSSBrDeployed = SrcBladedDLLTypeData%TimeHSSBrDeployed + DstBladedDLLTypeData%OverrideYawRateWithTorque = SrcBladedDLLTypeData%OverrideYawRateWithTorque + DstBladedDLLTypeData%YawTorqueDemand = SrcBladedDLLTypeData%YawTorqueDemand +IF (ALLOCATED(SrcBladedDLLTypeData%BlPitchInput)) THEN + i1_l = LBOUND(SrcBladedDLLTypeData%BlPitchInput,1) + i1_u = UBOUND(SrcBladedDLLTypeData%BlPitchInput,1) + IF (.NOT. ALLOCATED(DstBladedDLLTypeData%BlPitchInput)) THEN + ALLOCATE(DstBladedDLLTypeData%BlPitchInput(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%BlPitchInput.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstBladedDLLTypeData%BlPitchInput = SrcBladedDLLTypeData%BlPitchInput +ENDIF + DstBladedDLLTypeData%YawAngleFromNorth = SrcBladedDLLTypeData%YawAngleFromNorth + DstBladedDLLTypeData%HorWindV = SrcBladedDLLTypeData%HorWindV + DstBladedDLLTypeData%HSS_Spd = SrcBladedDLLTypeData%HSS_Spd + DstBladedDLLTypeData%YawErr = SrcBladedDLLTypeData%YawErr + DstBladedDLLTypeData%RotSpeed = SrcBladedDLLTypeData%RotSpeed + DstBladedDLLTypeData%YawBrTAxp = SrcBladedDLLTypeData%YawBrTAxp + DstBladedDLLTypeData%YawBrTAyp = SrcBladedDLLTypeData%YawBrTAyp + DstBladedDLLTypeData%LSSTipMys = SrcBladedDLLTypeData%LSSTipMys + DstBladedDLLTypeData%LSSTipMzs = SrcBladedDLLTypeData%LSSTipMzs + DstBladedDLLTypeData%LSSTipMya = SrcBladedDLLTypeData%LSSTipMya + DstBladedDLLTypeData%LSSTipMza = SrcBladedDLLTypeData%LSSTipMza + DstBladedDLLTypeData%LSSTipPxa = SrcBladedDLLTypeData%LSSTipPxa + DstBladedDLLTypeData%Yaw = SrcBladedDLLTypeData%Yaw + DstBladedDLLTypeData%YawRate = SrcBladedDLLTypeData%YawRate + DstBladedDLLTypeData%YawBrMyn = SrcBladedDLLTypeData%YawBrMyn + DstBladedDLLTypeData%YawBrMzn = SrcBladedDLLTypeData%YawBrMzn + DstBladedDLLTypeData%NcIMURAxs = SrcBladedDLLTypeData%NcIMURAxs + DstBladedDLLTypeData%NcIMURAys = SrcBladedDLLTypeData%NcIMURAys + DstBladedDLLTypeData%NcIMURAzs = SrcBladedDLLTypeData%NcIMURAzs + DstBladedDLLTypeData%RotPwr = SrcBladedDLLTypeData%RotPwr + DstBladedDLLTypeData%LSSTipMxa = SrcBladedDLLTypeData%LSSTipMxa + DstBladedDLLTypeData%RootMyc = SrcBladedDLLTypeData%RootMyc + DstBladedDLLTypeData%RootMxc = SrcBladedDLLTypeData%RootMxc + DstBladedDLLTypeData%DLL_DT = SrcBladedDLLTypeData%DLL_DT + DstBladedDLLTypeData%DLL_InFile = SrcBladedDLLTypeData%DLL_InFile + DstBladedDLLTypeData%RootName = SrcBladedDLLTypeData%RootName + DstBladedDLLTypeData%GenTrq_Dem = SrcBladedDLLTypeData%GenTrq_Dem + DstBladedDLLTypeData%GenSpd_Dem = SrcBladedDLLTypeData%GenSpd_Dem + DstBladedDLLTypeData%Ptch_Max = SrcBladedDLLTypeData%Ptch_Max + DstBladedDLLTypeData%Ptch_Min = SrcBladedDLLTypeData%Ptch_Min + DstBladedDLLTypeData%Ptch_SetPnt = SrcBladedDLLTypeData%Ptch_SetPnt + DstBladedDLLTypeData%PtchRate_Max = SrcBladedDLLTypeData%PtchRate_Max + DstBladedDLLTypeData%PtchRate_Min = SrcBladedDLLTypeData%PtchRate_Min + DstBladedDLLTypeData%GenPwr_Dem = SrcBladedDLLTypeData%GenPwr_Dem + DstBladedDLLTypeData%Gain_OM = SrcBladedDLLTypeData%Gain_OM + DstBladedDLLTypeData%GenSpd_MaxOM = SrcBladedDLLTypeData%GenSpd_MaxOM + DstBladedDLLTypeData%GenSpd_MinOM = SrcBladedDLLTypeData%GenSpd_MinOM + DstBladedDLLTypeData%Ptch_Cntrl = SrcBladedDLLTypeData%Ptch_Cntrl + DstBladedDLLTypeData%DLL_NumTrq = SrcBladedDLLTypeData%DLL_NumTrq +IF (ALLOCATED(SrcBladedDLLTypeData%GenSpd_TLU)) THEN + i1_l = LBOUND(SrcBladedDLLTypeData%GenSpd_TLU,1) + i1_u = UBOUND(SrcBladedDLLTypeData%GenSpd_TLU,1) + IF (.NOT. ALLOCATED(DstBladedDLLTypeData%GenSpd_TLU)) THEN + ALLOCATE(DstBladedDLLTypeData%GenSpd_TLU(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%GenSpd_TLU.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstBladedDLLTypeData%GenSpd_TLU = SrcBladedDLLTypeData%GenSpd_TLU +ENDIF +IF (ALLOCATED(SrcBladedDLLTypeData%GenTrq_TLU)) THEN + i1_l = LBOUND(SrcBladedDLLTypeData%GenTrq_TLU,1) + i1_u = UBOUND(SrcBladedDLLTypeData%GenTrq_TLU,1) + IF (.NOT. ALLOCATED(DstBladedDLLTypeData%GenTrq_TLU)) THEN + ALLOCATE(DstBladedDLLTypeData%GenTrq_TLU(i1_l:i1_u),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating DstBladedDLLTypeData%GenTrq_TLU.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + END IF + DstBladedDLLTypeData%GenTrq_TLU = SrcBladedDLLTypeData%GenTrq_TLU +ENDIF + DstBladedDLLTypeData%Yaw_Cntrl = SrcBladedDLLTypeData%Yaw_Cntrl END SUBROUTINE SrvD_CopyBladedDLLType SUBROUTINE SrvD_DestroyBladedDLLType( BladedDLLTypeData, ErrStat, ErrMsg ) @@ -2146,6 +2251,24 @@ SUBROUTINE SrvD_DestroyBladedDLLType( BladedDLLTypeData, ErrStat, ErrMsg ) ENDIF IF (ALLOCATED(BladedDLLTypeData%SCoutput)) THEN DEALLOCATE(BladedDLLTypeData%SCoutput) +ENDIF +IF (ALLOCATED(BladedDLLTypeData%LogChannels_OutParam)) THEN +DO i1 = LBOUND(BladedDLLTypeData%LogChannels_OutParam,1), UBOUND(BladedDLLTypeData%LogChannels_OutParam,1) + CALL NWTC_Library_Destroyoutparmtype( BladedDLLTypeData%LogChannels_OutParam(i1), ErrStat, ErrMsg ) +ENDDO + DEALLOCATE(BladedDLLTypeData%LogChannels_OutParam) +ENDIF +IF (ALLOCATED(BladedDLLTypeData%LogChannels)) THEN + DEALLOCATE(BladedDLLTypeData%LogChannels) +ENDIF +IF (ALLOCATED(BladedDLLTypeData%BlPitchInput)) THEN + DEALLOCATE(BladedDLLTypeData%BlPitchInput) +ENDIF +IF (ALLOCATED(BladedDLLTypeData%GenSpd_TLU)) THEN + DEALLOCATE(BladedDLLTypeData%GenSpd_TLU) +ENDIF +IF (ALLOCATED(BladedDLLTypeData%GenTrq_TLU)) THEN + DEALLOCATE(BladedDLLTypeData%GenTrq_TLU) ENDIF END SUBROUTINE SrvD_DestroyBladedDLLType @@ -2189,19 +2312,116 @@ SUBROUTINE SrvD_PackBladedDLLType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Int_BufSz = Int_BufSz + 2*1 ! avrSWAP upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%avrSWAP) ! avrSWAP END IF - Re_BufSz = Re_BufSz + 1 ! HSSBrFrac - Re_BufSz = Re_BufSz + 1 ! HSSBrTrqC + Re_BufSz = Re_BufSz + 1 ! HSSBrTrqDemand Re_BufSz = Re_BufSz + 1 ! YawRateCom Re_BufSz = Re_BufSz + 1 ! GenTrq Int_BufSz = Int_BufSz + 1 ! GenState Re_BufSz = Re_BufSz + SIZE(InData%BlPitchCom) ! BlPitchCom Re_BufSz = Re_BufSz + SIZE(InData%PrevBlPitch) ! PrevBlPitch Re_BufSz = Re_BufSz + SIZE(InData%BlAirfoilCom) ! BlAirfoilCom + Re_BufSz = Re_BufSz + 1 ! ElecPwr_prev + Re_BufSz = Re_BufSz + 1 ! GenTrq_prev Int_BufSz = Int_BufSz + 1 ! SCoutput allocated yes/no IF ( ALLOCATED(InData%SCoutput) ) THEN Int_BufSz = Int_BufSz + 2*1 ! SCoutput upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%SCoutput) ! SCoutput END IF + Int_BufSz = Int_BufSz + 1 ! initialized + Int_BufSz = Int_BufSz + 1 ! NumLogChannels + Int_BufSz = Int_BufSz + 1 ! LogChannels_OutParam allocated yes/no + IF ( ALLOCATED(InData%LogChannels_OutParam) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! LogChannels_OutParam upper/lower bounds for each dimension + ! Allocate buffers for subtypes, if any (we'll get sizes from these) + DO i1 = LBOUND(InData%LogChannels_OutParam,1), UBOUND(InData%LogChannels_OutParam,1) + Int_BufSz = Int_BufSz + 3 ! LogChannels_OutParam: size of buffers for each call to pack subtype + CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%LogChannels_OutParam(i1), ErrStat2, ErrMsg2, .TRUE. ) ! LogChannels_OutParam + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN ! LogChannels_OutParam + Re_BufSz = Re_BufSz + SIZE( Re_Buf ) + DEALLOCATE(Re_Buf) + END IF + IF(ALLOCATED(Db_Buf)) THEN ! LogChannels_OutParam + Db_BufSz = Db_BufSz + SIZE( Db_Buf ) + DEALLOCATE(Db_Buf) + END IF + IF(ALLOCATED(Int_Buf)) THEN ! LogChannels_OutParam + Int_BufSz = Int_BufSz + SIZE( Int_Buf ) + DEALLOCATE(Int_Buf) + END IF + END DO + END IF + Int_BufSz = Int_BufSz + 1 ! LogChannels allocated yes/no + IF ( ALLOCATED(InData%LogChannels) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! LogChannels upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%LogChannels) ! LogChannels + END IF + Int_BufSz = Int_BufSz + 1 ! ErrStat + Int_BufSz = Int_BufSz + 1*LEN(InData%ErrMsg) ! ErrMsg + Db_BufSz = Db_BufSz + 1 ! CurrentTime + Int_BufSz = Int_BufSz + 1 ! SimStatus + Int_BufSz = Int_BufSz + 1 ! ShaftBrakeStatusBinaryFlag + Int_BufSz = Int_BufSz + 1 ! HSSBrDeployed + Db_BufSz = Db_BufSz + 1 ! TimeHSSBrFullyDeployed + Db_BufSz = Db_BufSz + 1 ! TimeHSSBrDeployed + Int_BufSz = Int_BufSz + 1 ! OverrideYawRateWithTorque + Re_BufSz = Re_BufSz + 1 ! YawTorqueDemand + Int_BufSz = Int_BufSz + 1 ! BlPitchInput allocated yes/no + IF ( ALLOCATED(InData%BlPitchInput) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! BlPitchInput upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%BlPitchInput) ! BlPitchInput + END IF + Re_BufSz = Re_BufSz + 1 ! YawAngleFromNorth + Re_BufSz = Re_BufSz + 1 ! HorWindV + Re_BufSz = Re_BufSz + 1 ! HSS_Spd + Re_BufSz = Re_BufSz + 1 ! YawErr + Re_BufSz = Re_BufSz + 1 ! RotSpeed + Re_BufSz = Re_BufSz + 1 ! YawBrTAxp + Re_BufSz = Re_BufSz + 1 ! YawBrTAyp + Re_BufSz = Re_BufSz + 1 ! LSSTipMys + Re_BufSz = Re_BufSz + 1 ! LSSTipMzs + Re_BufSz = Re_BufSz + 1 ! LSSTipMya + Re_BufSz = Re_BufSz + 1 ! LSSTipMza + Re_BufSz = Re_BufSz + 1 ! LSSTipPxa + Re_BufSz = Re_BufSz + 1 ! Yaw + Re_BufSz = Re_BufSz + 1 ! YawRate + Re_BufSz = Re_BufSz + 1 ! YawBrMyn + Re_BufSz = Re_BufSz + 1 ! YawBrMzn + Re_BufSz = Re_BufSz + 1 ! NcIMURAxs + Re_BufSz = Re_BufSz + 1 ! NcIMURAys + Re_BufSz = Re_BufSz + 1 ! NcIMURAzs + Re_BufSz = Re_BufSz + 1 ! RotPwr + Re_BufSz = Re_BufSz + 1 ! LSSTipMxa + Re_BufSz = Re_BufSz + SIZE(InData%RootMyc) ! RootMyc + Re_BufSz = Re_BufSz + SIZE(InData%RootMxc) ! RootMxc + Db_BufSz = Db_BufSz + 1 ! DLL_DT + Int_BufSz = Int_BufSz + 1*LEN(InData%DLL_InFile) ! DLL_InFile + Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName + Re_BufSz = Re_BufSz + 1 ! GenTrq_Dem + Re_BufSz = Re_BufSz + 1 ! GenSpd_Dem + Re_BufSz = Re_BufSz + 1 ! Ptch_Max + Re_BufSz = Re_BufSz + 1 ! Ptch_Min + Re_BufSz = Re_BufSz + 1 ! Ptch_SetPnt + Re_BufSz = Re_BufSz + 1 ! PtchRate_Max + Re_BufSz = Re_BufSz + 1 ! PtchRate_Min + Re_BufSz = Re_BufSz + 1 ! GenPwr_Dem + Re_BufSz = Re_BufSz + 1 ! Gain_OM + Re_BufSz = Re_BufSz + 1 ! GenSpd_MaxOM + Re_BufSz = Re_BufSz + 1 ! GenSpd_MinOM + Int_BufSz = Int_BufSz + 1 ! Ptch_Cntrl + Int_BufSz = Int_BufSz + 1 ! DLL_NumTrq + Int_BufSz = Int_BufSz + 1 ! GenSpd_TLU allocated yes/no + IF ( ALLOCATED(InData%GenSpd_TLU) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! GenSpd_TLU upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%GenSpd_TLU) ! GenSpd_TLU + END IF + Int_BufSz = Int_BufSz + 1 ! GenTrq_TLU allocated yes/no + IF ( ALLOCATED(InData%GenTrq_TLU) ) THEN + Int_BufSz = Int_BufSz + 2*1 ! GenTrq_TLU upper/lower bounds for each dimension + Re_BufSz = Re_BufSz + SIZE(InData%GenTrq_TLU) ! GenTrq_TLU + END IF + Int_BufSz = Int_BufSz + 1 ! Yaw_Cntrl IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -2239,25 +2459,35 @@ SUBROUTINE SrvD_PackBladedDLLType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%avrSWAP,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%avrSWAP)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%avrSWAP))-1 ) = PACK(InData%avrSWAP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%avrSWAP) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HSSBrFrac - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HSSBrTrqC - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawRateCom - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GenTrq - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%GenState - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlPitchCom))-1 ) = PACK(InData%BlPitchCom,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlPitchCom) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PrevBlPitch))-1 ) = PACK(InData%PrevBlPitch,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PrevBlPitch) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlAirfoilCom))-1 ) = PACK(InData%BlAirfoilCom,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlAirfoilCom) + DO i1 = LBOUND(InData%avrSWAP,1), UBOUND(InData%avrSWAP,1) + ReKiBuf(Re_Xferred) = InData%avrSWAP(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%HSSBrTrqDemand + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawRateCom + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GenTrq + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%GenState + Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(InData%BlPitchCom,1), UBOUND(InData%BlPitchCom,1) + ReKiBuf(Re_Xferred) = InData%BlPitchCom(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%PrevBlPitch,1), UBOUND(InData%PrevBlPitch,1) + ReKiBuf(Re_Xferred) = InData%PrevBlPitch(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%BlAirfoilCom,1), UBOUND(InData%BlAirfoilCom,1) + ReKiBuf(Re_Xferred) = InData%BlAirfoilCom(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%ElecPwr_prev + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GenTrq_prev + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%SCoutput) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2268,9 +2498,226 @@ SUBROUTINE SrvD_PackBladedDLLType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SCoutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%SCoutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SCoutput))-1 ) = PACK(InData%SCoutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SCoutput) + DO i1 = LBOUND(InData%SCoutput,1), UBOUND(InData%SCoutput,1) + ReKiBuf(Re_Xferred) = InData%SCoutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF + IntKiBuf(Int_Xferred) = TRANSFER(InData%initialized, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumLogChannels + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%LogChannels_OutParam) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%LogChannels_OutParam,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LogChannels_OutParam,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%LogChannels_OutParam,1), UBOUND(InData%LogChannels_OutParam,1) + CALL NWTC_Library_Packoutparmtype( Re_Buf, Db_Buf, Int_Buf, InData%LogChannels_OutParam(i1), ErrStat2, ErrMsg2, OnlySize ) ! LogChannels_OutParam + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Re_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Re_Buf) > 0) ReKiBuf( Re_Xferred:Re_Xferred+SIZE(Re_Buf)-1 ) = Re_Buf + Re_Xferred = Re_Xferred + SIZE(Re_Buf) + DEALLOCATE(Re_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Db_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Db_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Db_Buf) > 0) DbKiBuf( Db_Xferred:Db_Xferred+SIZE(Db_Buf)-1 ) = Db_Buf + Db_Xferred = Db_Xferred + SIZE(Db_Buf) + DEALLOCATE(Db_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + IF(ALLOCATED(Int_Buf)) THEN + IntKiBuf( Int_Xferred ) = SIZE(Int_Buf); Int_Xferred = Int_Xferred + 1 + IF (SIZE(Int_Buf) > 0) IntKiBuf( Int_Xferred:Int_Xferred+SIZE(Int_Buf)-1 ) = Int_Buf + Int_Xferred = Int_Xferred + SIZE(Int_Buf) + DEALLOCATE(Int_Buf) + ELSE + IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 + ENDIF + END DO + END IF + IF ( .NOT. ALLOCATED(InData%LogChannels) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%LogChannels,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%LogChannels,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%LogChannels,1), UBOUND(InData%LogChannels,1) + ReKiBuf(Re_Xferred) = InData%LogChannels(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IntKiBuf(Int_Xferred) = InData%ErrStat + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%ErrMsg) + IntKiBuf(Int_Xferred) = ICHAR(InData%ErrMsg(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DbKiBuf(Db_Xferred) = InData%CurrentTime + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%SimStatus + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%ShaftBrakeStatusBinaryFlag + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%HSSBrDeployed, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%TimeHSSBrFullyDeployed + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%TimeHSSBrDeployed + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%OverrideYawRateWithTorque, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawTorqueDemand + Re_Xferred = Re_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%BlPitchInput) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%BlPitchInput,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlPitchInput,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%BlPitchInput,1), UBOUND(InData%BlPitchInput,1) + ReKiBuf(Re_Xferred) = InData%BlPitchInput(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%YawAngleFromNorth + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HorWindV + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HSS_Spd + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawErr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RotSpeed + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawBrTAxp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawBrTAyp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%LSSTipMys + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%LSSTipMzs + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%LSSTipMya + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%LSSTipMza + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%LSSTipPxa + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Yaw + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawRate + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawBrMyn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawBrMzn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NcIMURAxs + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NcIMURAys + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NcIMURAzs + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RotPwr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%LSSTipMxa + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%RootMyc,1), UBOUND(InData%RootMyc,1) + ReKiBuf(Re_Xferred) = InData%RootMyc(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%RootMxc,1), UBOUND(InData%RootMxc,1) + ReKiBuf(Re_Xferred) = InData%RootMxc(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DbKiBuf(Db_Xferred) = InData%DLL_DT + Db_Xferred = Db_Xferred + 1 + DO I = 1, LEN(InData%DLL_InFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_InFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + ReKiBuf(Re_Xferred) = InData%GenTrq_Dem + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GenSpd_Dem + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Ptch_Max + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Ptch_Min + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Ptch_SetPnt + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtchRate_Max + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%PtchRate_Min + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GenPwr_Dem + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Gain_OM + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GenSpd_MaxOM + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GenSpd_MinOM + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Ptch_Cntrl + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DLL_NumTrq + Int_Xferred = Int_Xferred + 1 + IF ( .NOT. ALLOCATED(InData%GenSpd_TLU) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%GenSpd_TLU,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GenSpd_TLU,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%GenSpd_TLU,1), UBOUND(InData%GenSpd_TLU,1) + ReKiBuf(Re_Xferred) = InData%GenSpd_TLU(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( .NOT. ALLOCATED(InData%GenTrq_TLU) ) THEN + IntKiBuf( Int_Xferred ) = 0 + Int_Xferred = Int_Xferred + 1 + ELSE + IntKiBuf( Int_Xferred ) = 1 + Int_Xferred = Int_Xferred + 1 + IntKiBuf( Int_Xferred ) = LBOUND(InData%GenTrq_TLU,1) + IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GenTrq_TLU,1) + Int_Xferred = Int_Xferred + 2 + + DO i1 = LBOUND(InData%GenTrq_TLU,1), UBOUND(InData%GenTrq_TLU,1) + ReKiBuf(Re_Xferred) = InData%GenTrq_TLU(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IntKiBuf(Int_Xferred) = InData%Yaw_Cntrl + Int_Xferred = Int_Xferred + 1 END SUBROUTINE SrvD_PackBladedDLLType SUBROUTINE SrvD_UnPackBladedDLLType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2286,12 +2733,6 @@ SUBROUTINE SrvD_UnPackBladedDLLType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -2319,82 +2760,305 @@ SUBROUTINE SrvD_UnPackBladedDLLType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%avrSWAP.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) + DO i1 = LBOUND(OutData%avrSWAP,1), UBOUND(OutData%avrSWAP,1) + OutData%avrSWAP(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%HSSBrTrqDemand = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawRateCom = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GenTrq = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GenState = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + i1_l = LBOUND(OutData%BlPitchCom,1) + i1_u = UBOUND(OutData%BlPitchCom,1) + DO i1 = LBOUND(OutData%BlPitchCom,1), UBOUND(OutData%BlPitchCom,1) + OutData%BlPitchCom(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + i1_l = LBOUND(OutData%PrevBlPitch,1) + i1_u = UBOUND(OutData%PrevBlPitch,1) + DO i1 = LBOUND(OutData%PrevBlPitch,1), UBOUND(OutData%PrevBlPitch,1) + OutData%PrevBlPitch(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + i1_l = LBOUND(OutData%BlAirfoilCom,1) + i1_u = UBOUND(OutData%BlAirfoilCom,1) + DO i1 = LBOUND(OutData%BlAirfoilCom,1), UBOUND(OutData%BlAirfoilCom,1) + OutData%BlAirfoilCom(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%ElecPwr_prev = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GenTrq_prev = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SCoutput not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%SCoutput)) DEALLOCATE(OutData%SCoutput) + ALLOCATE(OutData%SCoutput(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SCoutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - mask1 = .TRUE. - IF (SIZE(OutData%avrSWAP)>0) OutData%avrSWAP = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%avrSWAP))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%avrSWAP) - DEALLOCATE(mask1) - END IF - OutData%HSSBrFrac = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HSSBrTrqC = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawRateCom = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GenTrq = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GenState = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - i1_l = LBOUND(OutData%BlPitchCom,1) - i1_u = UBOUND(OutData%BlPitchCom,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) + DO i1 = LBOUND(OutData%SCoutput,1), UBOUND(OutData%SCoutput,1) + OutData%SCoutput(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%initialized = TRANSFER(IntKiBuf(Int_Xferred), OutData%initialized) + Int_Xferred = Int_Xferred + 1 + OutData%NumLogChannels = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LogChannels_OutParam not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%LogChannels_OutParam)) DEALLOCATE(OutData%LogChannels_OutParam) + ALLOCATE(OutData%LogChannels_OutParam(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LogChannels_OutParam.', ErrStat, ErrMsg,RoutineName) RETURN END IF - mask1 = .TRUE. - OutData%BlPitchCom = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlPitchCom))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlPitchCom) - DEALLOCATE(mask1) - i1_l = LBOUND(OutData%PrevBlPitch,1) - i1_u = UBOUND(OutData%PrevBlPitch,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) + DO i1 = LBOUND(OutData%LogChannels_OutParam,1), UBOUND(OutData%LogChannels_OutParam,1) + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Re_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Re_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Re_Buf = ReKiBuf( Re_Xferred:Re_Xferred+Buf_size-1 ) + Re_Xferred = Re_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Db_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Db_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Db_Buf = DbKiBuf( Db_Xferred:Db_Xferred+Buf_size-1 ) + Db_Xferred = Db_Xferred + Buf_size + END IF + Buf_size=IntKiBuf( Int_Xferred ) + Int_Xferred = Int_Xferred + 1 + IF(Buf_size > 0) THEN + ALLOCATE(Int_Buf(Buf_size),STAT=ErrStat2) + IF (ErrStat2 /= 0) THEN + CALL SetErrStat(ErrID_Fatal, 'Error allocating Int_Buf.', ErrStat, ErrMsg,RoutineName) + RETURN + END IF + Int_Buf = IntKiBuf( Int_Xferred:Int_Xferred+Buf_size-1 ) + Int_Xferred = Int_Xferred + Buf_size + END IF + CALL NWTC_Library_Unpackoutparmtype( Re_Buf, Db_Buf, Int_Buf, OutData%LogChannels_OutParam(i1), ErrStat2, ErrMsg2 ) ! LogChannels_OutParam + CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) + IF (ErrStat >= AbortErrLev) RETURN + + IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) + IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) + IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! LogChannels not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%LogChannels)) DEALLOCATE(OutData%LogChannels) + ALLOCATE(OutData%LogChannels(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%LogChannels.', ErrStat, ErrMsg,RoutineName) RETURN END IF - mask1 = .TRUE. - OutData%PrevBlPitch = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PrevBlPitch))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PrevBlPitch) - DEALLOCATE(mask1) - i1_l = LBOUND(OutData%BlAirfoilCom,1) - i1_u = UBOUND(OutData%BlAirfoilCom,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) + DO i1 = LBOUND(OutData%LogChannels,1), UBOUND(OutData%LogChannels,1) + OutData%LogChannels(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%ErrStat = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%ErrMsg) + OutData%ErrMsg(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%CurrentTime = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%SimStatus = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%ShaftBrakeStatusBinaryFlag = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%HSSBrDeployed = TRANSFER(IntKiBuf(Int_Xferred), OutData%HSSBrDeployed) + Int_Xferred = Int_Xferred + 1 + OutData%TimeHSSBrFullyDeployed = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%TimeHSSBrDeployed = REAL(DbKiBuf(Db_Xferred), R8Ki) + Db_Xferred = Db_Xferred + 1 + OutData%OverrideYawRateWithTorque = TRANSFER(IntKiBuf(Int_Xferred), OutData%OverrideYawRateWithTorque) + Int_Xferred = Int_Xferred + 1 + OutData%YawTorqueDemand = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlPitchInput not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%BlPitchInput)) DEALLOCATE(OutData%BlPitchInput) + ALLOCATE(OutData%BlPitchInput(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitchInput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - mask1 = .TRUE. - OutData%BlAirfoilCom = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlAirfoilCom))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlAirfoilCom) - DEALLOCATE(mask1) - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SCoutput not allocated + DO i1 = LBOUND(OutData%BlPitchInput,1), UBOUND(OutData%BlPitchInput,1) + OutData%BlPitchInput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%YawAngleFromNorth = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HorWindV = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HSS_Spd = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawErr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RotSpeed = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawBrTAxp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawBrTAyp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LSSTipMys = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LSSTipMzs = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LSSTipMya = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LSSTipMza = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LSSTipPxa = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Yaw = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawRate = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawBrMyn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawBrMzn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NcIMURAxs = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NcIMURAys = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NcIMURAzs = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RotPwr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LSSTipMxa = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + i1_l = LBOUND(OutData%RootMyc,1) + i1_u = UBOUND(OutData%RootMyc,1) + DO i1 = LBOUND(OutData%RootMyc,1), UBOUND(OutData%RootMyc,1) + OutData%RootMyc(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + i1_l = LBOUND(OutData%RootMxc,1) + i1_u = UBOUND(OutData%RootMxc,1) + DO i1 = LBOUND(OutData%RootMxc,1), UBOUND(OutData%RootMxc,1) + OutData%RootMxc(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%DLL_DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + DO I = 1, LEN(OutData%DLL_InFile) + OutData%DLL_InFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%GenTrq_Dem = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GenSpd_Dem = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Ptch_Max = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Ptch_Min = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Ptch_SetPnt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtchRate_Max = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%PtchRate_Min = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GenPwr_Dem = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Gain_OM = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GenSpd_MaxOM = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GenSpd_MinOM = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Ptch_Cntrl = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%DLL_NumTrq = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GenSpd_TLU not allocated Int_Xferred = Int_Xferred + 1 ELSE Int_Xferred = Int_Xferred + 1 i1_l = IntKiBuf( Int_Xferred ) i1_u = IntKiBuf( Int_Xferred + 1) Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%SCoutput)) DEALLOCATE(OutData%SCoutput) - ALLOCATE(OutData%SCoutput(i1_l:i1_u),STAT=ErrStat2) + IF (ALLOCATED(OutData%GenSpd_TLU)) DEALLOCATE(OutData%GenSpd_TLU) + ALLOCATE(OutData%GenSpd_TLU(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SCoutput.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GenSpd_TLU.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) + DO i1 = LBOUND(OutData%GenSpd_TLU,1), UBOUND(OutData%GenSpd_TLU,1) + OutData%GenSpd_TLU(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GenTrq_TLU not allocated + Int_Xferred = Int_Xferred + 1 + ELSE + Int_Xferred = Int_Xferred + 1 + i1_l = IntKiBuf( Int_Xferred ) + i1_u = IntKiBuf( Int_Xferred + 1) + Int_Xferred = Int_Xferred + 2 + IF (ALLOCATED(OutData%GenTrq_TLU)) DEALLOCATE(OutData%GenTrq_TLU) + ALLOCATE(OutData%GenTrq_TLU(i1_l:i1_u),STAT=ErrStat2) IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) + CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GenTrq_TLU.', ErrStat, ErrMsg,RoutineName) RETURN END IF - mask1 = .TRUE. - IF (SIZE(OutData%SCoutput)>0) OutData%SCoutput = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SCoutput))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%SCoutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%GenTrq_TLU,1), UBOUND(OutData%GenTrq_TLU,1) + OutData%GenTrq_TLU(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF + OutData%Yaw_Cntrl = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE SrvD_UnPackBladedDLLType SUBROUTINE SrvD_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) @@ -2531,8 +3195,8 @@ SUBROUTINE SrvD_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyContState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyContState + Re_Xferred = Re_Xferred + 1 CALL TMD_PackContState( Re_Buf, Db_Buf, Int_Buf, InData%NTMD, ErrStat2, ErrMsg2, OnlySize ) ! NTMD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2604,12 +3268,6 @@ SUBROUTINE SrvD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_UnPackContState' @@ -2623,8 +3281,8 @@ SUBROUTINE SrvD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyContState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyContState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -2721,6 +3379,7 @@ SUBROUTINE SrvD_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, Err ! ErrStat = ErrID_None ErrMsg = "" + DstDiscStateData%CtrlOffset = SrcDiscStateData%CtrlOffset CALL TMD_CopyDiscState( SrcDiscStateData%NTMD, DstDiscStateData%NTMD, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN @@ -2777,6 +3436,7 @@ SUBROUTINE SrvD_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Re_BufSz = 0 Db_BufSz = 0 Int_BufSz = 0 + Re_BufSz = Re_BufSz + 1 ! CtrlOffset ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! NTMD: size of buffers for each call to pack subtype CALL TMD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%NTMD, ErrStat2, ErrMsg2, .TRUE. ) ! NTMD @@ -2839,6 +3499,8 @@ SUBROUTINE SrvD_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 + ReKiBuf(Re_Xferred) = InData%CtrlOffset + Re_Xferred = Re_Xferred + 1 CALL TMD_PackDiscState( Re_Buf, Db_Buf, Int_Buf, InData%NTMD, ErrStat2, ErrMsg2, OnlySize ) ! NTMD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -2910,12 +3572,6 @@ SUBROUTINE SrvD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_UnPackDiscState' @@ -2929,6 +3585,8 @@ SUBROUTINE SrvD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 + OutData%CtrlOffset = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -3145,8 +3803,8 @@ SUBROUTINE SrvD_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyConstrState + Re_Xferred = Re_Xferred + 1 CALL TMD_PackConstrState( Re_Buf, Db_Buf, Int_Buf, InData%NTMD, ErrStat2, ErrMsg2, OnlySize ) ! NTMD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3218,12 +3876,6 @@ SUBROUTINE SrvD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_UnPackConstrState' @@ -3237,8 +3889,8 @@ SUBROUTINE SrvD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyConstrState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyConstrState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -3596,8 +4248,10 @@ SUBROUTINE SrvD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BegPitMan,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BegPitMan)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%BegPitMan)-1 ) = TRANSFER(PACK( InData%BegPitMan ,.TRUE.), IntKiBuf(1), SIZE(InData%BegPitMan)) - Int_Xferred = Int_Xferred + SIZE(InData%BegPitMan) + DO i1 = LBOUND(InData%BegPitMan,1), UBOUND(InData%BegPitMan,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%BegPitMan(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%BlPitchI) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3609,8 +4263,10 @@ SUBROUTINE SrvD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlPitchI,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BlPitchI)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlPitchI))-1 ) = PACK(InData%BlPitchI,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlPitchI) + DO i1 = LBOUND(InData%BlPitchI,1), UBOUND(InData%BlPitchI,1) + ReKiBuf(Re_Xferred) = InData%BlPitchI(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TPitManE) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3622,17 +4278,19 @@ SUBROUTINE SrvD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TPitManE,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TPitManE)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%TPitManE))-1 ) = PACK(InData%TPitManE,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%TPitManE) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%BegYawMan , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NacYawI - Re_Xferred = Re_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%TYawManE - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawPosComInt - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%TPitManE,1), UBOUND(InData%TPitManE,1) + DbKiBuf(Db_Xferred) = InData%TPitManE(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + IntKiBuf(Int_Xferred) = TRANSFER(InData%BegYawMan, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NacYawI + Re_Xferred = Re_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%TYawManE + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawPosComInt + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%BegTpBr) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -3643,8 +4301,10 @@ SUBROUTINE SrvD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BegTpBr,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BegTpBr)>0) IntKiBuf ( Int_Xferred:Int_Xferred+SIZE(InData%BegTpBr)-1 ) = TRANSFER(PACK( InData%BegTpBr ,.TRUE.), IntKiBuf(1), SIZE(InData%BegTpBr)) - Int_Xferred = Int_Xferred + SIZE(InData%BegTpBr) + DO i1 = LBOUND(InData%BegTpBr,1), UBOUND(InData%BegTpBr,1) + IntKiBuf(Int_Xferred) = TRANSFER(InData%BegTpBr(i1), IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TTpBrDp) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3656,8 +4316,10 @@ SUBROUTINE SrvD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TTpBrDp,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TTpBrDp)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%TTpBrDp))-1 ) = PACK(InData%TTpBrDp,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%TTpBrDp) + DO i1 = LBOUND(InData%TTpBrDp,1), UBOUND(InData%TTpBrDp,1) + DbKiBuf(Db_Xferred) = InData%TTpBrDp(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TTpBrFl) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3669,13 +4331,15 @@ SUBROUTINE SrvD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TTpBrFl,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TTpBrFl)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%TTpBrFl))-1 ) = PACK(InData%TTpBrFl,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%TTpBrFl) + DO i1 = LBOUND(InData%TTpBrFl,1), UBOUND(InData%TTpBrFl,1) + DbKiBuf(Db_Xferred) = InData%TTpBrFl(i1) + Db_Xferred = Db_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Off4Good , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%GenOnLine , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%Off4Good, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%GenOnLine, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 CALL TMD_PackOtherState( Re_Buf, Db_Buf, Int_Buf, InData%NTMD, ErrStat2, ErrMsg2, OnlySize ) ! NTMD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -3747,12 +4411,6 @@ SUBROUTINE SrvD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -3780,15 +4438,10 @@ SUBROUTINE SrvD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BegPitMan.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BegPitMan)>0) OutData%BegPitMan = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%BegPitMan))-1 ), OutData%BegPitMan), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%BegPitMan) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BegPitMan,1), UBOUND(OutData%BegPitMan,1) + OutData%BegPitMan(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%BegPitMan(i1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlPitchI not allocated Int_Xferred = Int_Xferred + 1 @@ -3803,15 +4456,10 @@ SUBROUTINE SrvD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitchI.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BlPitchI)>0) OutData%BlPitchI = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlPitchI))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlPitchI) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BlPitchI,1), UBOUND(OutData%BlPitchI,1) + OutData%BlPitchI(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TPitManE not allocated Int_Xferred = Int_Xferred + 1 @@ -3826,24 +4474,19 @@ SUBROUTINE SrvD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TPitManE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TPitManE)>0) OutData%TPitManE = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%TPitManE))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%TPitManE) - DEALLOCATE(mask1) - END IF - OutData%BegYawMan = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NacYawI = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TYawManE = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%YawPosComInt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%TPitManE,1), UBOUND(OutData%TPitManE,1) + OutData%TPitManE(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + OutData%BegYawMan = TRANSFER(IntKiBuf(Int_Xferred), OutData%BegYawMan) + Int_Xferred = Int_Xferred + 1 + OutData%NacYawI = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TYawManE = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%YawPosComInt = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BegTpBr not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3857,15 +4500,10 @@ SUBROUTINE SrvD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BegTpBr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BegTpBr)>0) OutData%BegTpBr = UNPACK( TRANSFER( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%BegTpBr))-1 ), OutData%BegTpBr), mask1,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(OutData%BegTpBr) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BegTpBr,1), UBOUND(OutData%BegTpBr,1) + OutData%BegTpBr(i1) = TRANSFER(IntKiBuf(Int_Xferred), OutData%BegTpBr(i1)) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TTpBrDp not allocated Int_Xferred = Int_Xferred + 1 @@ -3880,15 +4518,10 @@ SUBROUTINE SrvD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TTpBrDp.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TTpBrDp)>0) OutData%TTpBrDp = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%TTpBrDp))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%TTpBrDp) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TTpBrDp,1), UBOUND(OutData%TTpBrDp,1) + OutData%TTpBrDp(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TTpBrFl not allocated Int_Xferred = Int_Xferred + 1 @@ -3903,20 +4536,15 @@ SUBROUTINE SrvD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TTpBrFl.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TTpBrFl)>0) OutData%TTpBrFl = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%TTpBrFl))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%TTpBrFl) - DEALLOCATE(mask1) - END IF - OutData%Off4Good = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%GenOnLine = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%TTpBrFl,1), UBOUND(OutData%TTpBrFl,1) + OutData%TTpBrFl(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + OutData%Off4Good = TRANSFER(IntKiBuf(Int_Xferred), OutData%Off4Good) + Int_Xferred = Int_Xferred + 1 + OutData%GenOnLine = TRANSFER(IntKiBuf(Int_Xferred), OutData%GenOnLine) + Int_Xferred = Int_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -4179,8 +4807,8 @@ SUBROUTINE SrvD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%LastTimeCalled - Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%LastTimeCalled + Db_Xferred = Db_Xferred + 1 CALL SrvD_Packbladeddlltype( Re_Buf, Db_Buf, Int_Buf, InData%dll_data, ErrStat2, ErrMsg2, OnlySize ) ! dll_data CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -4209,10 +4837,10 @@ SUBROUTINE SrvD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%FirstWarn , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%LastTimeFiltered - Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%FirstWarn, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%LastTimeFiltered + Db_Xferred = Db_Xferred + 1 IF ( .NOT. ALLOCATED(InData%xd_BlPitchFilter) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -4223,8 +4851,10 @@ SUBROUTINE SrvD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%xd_BlPitchFilter,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%xd_BlPitchFilter)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%xd_BlPitchFilter))-1 ) = PACK(InData%xd_BlPitchFilter,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%xd_BlPitchFilter) + DO i1 = LBOUND(InData%xd_BlPitchFilter,1), UBOUND(InData%xd_BlPitchFilter,1) + ReKiBuf(Re_Xferred) = InData%xd_BlPitchFilter(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF CALL TMD_PackMisc( Re_Buf, Db_Buf, Int_Buf, InData%NTMD, ErrStat2, ErrMsg2, OnlySize ) ! NTMD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4297,12 +4927,6 @@ SUBROUTINE SrvD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -4317,8 +4941,8 @@ SUBROUTINE SrvD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%LastTimeCalled = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%LastTimeCalled = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -4359,10 +4983,10 @@ SUBROUTINE SrvD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%FirstWarn = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%LastTimeFiltered = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + OutData%FirstWarn = TRANSFER(IntKiBuf(Int_Xferred), OutData%FirstWarn) + Int_Xferred = Int_Xferred + 1 + OutData%LastTimeFiltered = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! xd_BlPitchFilter not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -4376,15 +5000,10 @@ SUBROUTINE SrvD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%xd_BlPitchFilter.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%xd_BlPitchFilter)>0) OutData%xd_BlPitchFilter = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%xd_BlPitchFilter))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%xd_BlPitchFilter) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%xd_BlPitchFilter,1), UBOUND(OutData%xd_BlPitchFilter,1) + OutData%xd_BlPitchFilter(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -4485,7 +5104,6 @@ SUBROUTINE SrvD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ErrMsg = "" DstParamData%DT = SrcParamData%DT DstParamData%HSSBrDT = SrcParamData%HSSBrDT - DstParamData%HSSBrFrac = SrcParamData%HSSBrFrac DstParamData%HSSBrTqF = SrcParamData%HSSBrTqF DstParamData%SIG_POSl = SrcParamData%SIG_POSl DstParamData%SIG_POTq = SrcParamData%SIG_POTq @@ -4543,7 +5161,6 @@ SUBROUTINE SrvD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg END IF DstParamData%PitManRat = SrcParamData%PitManRat ENDIF - DstParamData%BlAlpha = SrcParamData%BlAlpha DstParamData%YawManRat = SrcParamData%YawManRat DstParamData%NacYawF = SrcParamData%NacYawF DstParamData%SpdGenOn = SrcParamData%SpdGenOn @@ -4604,6 +5221,7 @@ SUBROUTINE SrvD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg DstParamData%CompNTMD = SrcParamData%CompNTMD DstParamData%CompTTMD = SrcParamData%CompTTMD DstParamData%NumOuts = SrcParamData%NumOuts + DstParamData%NumOuts_DLL = SrcParamData%NumOuts_DLL DstParamData%RootName = SrcParamData%RootName IF (ALLOCATED(SrcParamData%OutParam)) THEN i1_l = LBOUND(SrcParamData%OutParam,1) @@ -4623,56 +5241,24 @@ SUBROUTINE SrvD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ENDIF DstParamData%Delim = SrcParamData%Delim DstParamData%UseBladedInterface = SrcParamData%UseBladedInterface + DstParamData%UseLegacyInterface = SrcParamData%UseLegacyInterface + DstParamData%DLL_Trgt = SrcParamData%DLL_Trgt DstParamData%DLL_Ramp = SrcParamData%DLL_Ramp - DstParamData%DLL_DT = SrcParamData%DLL_DT - DstParamData%DLL_NumTrq = SrcParamData%DLL_NumTrq - DstParamData%Ptch_Cntrl = SrcParamData%Ptch_Cntrl - DstParamData%Gain_OM = SrcParamData%Gain_OM - DstParamData%GenPwr_Dem = SrcParamData%GenPwr_Dem - DstParamData%GenSpd_Dem = SrcParamData%GenSpd_Dem - DstParamData%GenSpd_MaxOM = SrcParamData%GenSpd_MaxOM - DstParamData%GenSpd_MinOM = SrcParamData%GenSpd_MinOM -IF (ALLOCATED(SrcParamData%GenSpd_TLU)) THEN - i1_l = LBOUND(SrcParamData%GenSpd_TLU,1) - i1_u = UBOUND(SrcParamData%GenSpd_TLU,1) - IF (.NOT. ALLOCATED(DstParamData%GenSpd_TLU)) THEN - ALLOCATE(DstParamData%GenSpd_TLU(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%GenSpd_TLU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%GenSpd_TLU = SrcParamData%GenSpd_TLU -ENDIF - DstParamData%GenTrq_Dem = SrcParamData%GenTrq_Dem -IF (ALLOCATED(SrcParamData%GenTrq_TLU)) THEN - i1_l = LBOUND(SrcParamData%GenTrq_TLU,1) - i1_u = UBOUND(SrcParamData%GenTrq_TLU,1) - IF (.NOT. ALLOCATED(DstParamData%GenTrq_TLU)) THEN - ALLOCATE(DstParamData%GenTrq_TLU(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating DstParamData%GenTrq_TLU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - END IF - DstParamData%GenTrq_TLU = SrcParamData%GenTrq_TLU -ENDIF - DstParamData%Ptch_Max = SrcParamData%Ptch_Max - DstParamData%Ptch_Min = SrcParamData%Ptch_Min - DstParamData%Ptch_SetPnt = SrcParamData%Ptch_SetPnt - DstParamData%PtchRate_Max = SrcParamData%PtchRate_Max - DstParamData%PtchRate_Min = SrcParamData%PtchRate_Min + DstParamData%BlAlpha = SrcParamData%BlAlpha + DstParamData%DLL_n = SrcParamData%DLL_n + DstParamData%avcOUTNAME_LEN = SrcParamData%avcOUTNAME_LEN DstParamData%NacYaw_North = SrcParamData%NacYaw_North - DstParamData%DLL_InFile = SrcParamData%DLL_InFile - DstParamData%DLL_Trgt = SrcParamData%DLL_Trgt + DstParamData%AvgWindSpeed = SrcParamData%AvgWindSpeed + DstParamData%AirDens = SrcParamData%AirDens + DstParamData%TrimCase = SrcParamData%TrimCase + DstParamData%TrimGain = SrcParamData%TrimGain + DstParamData%RotSpeedRef = SrcParamData%RotSpeedRef CALL TMD_CopyParam( SrcParamData%NTMD, DstParamData%NTMD, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN CALL TMD_CopyParam( SrcParamData%TTMD, DstParamData%TTMD, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN - DstParamData%AvgWindSpeed = SrcParamData%AvgWindSpeed - DstParamData%AirDens = SrcParamData%AirDens END SUBROUTINE SrvD_CopyParam SUBROUTINE SrvD_DestroyParam( ParamData, ErrStat, ErrMsg ) @@ -4704,12 +5290,6 @@ SUBROUTINE SrvD_DestroyParam( ParamData, ErrStat, ErrMsg ) CALL NWTC_Library_Destroyoutparmtype( ParamData%OutParam(i1), ErrStat, ErrMsg ) ENDDO DEALLOCATE(ParamData%OutParam) -ENDIF -IF (ALLOCATED(ParamData%GenSpd_TLU)) THEN - DEALLOCATE(ParamData%GenSpd_TLU) -ENDIF -IF (ALLOCATED(ParamData%GenTrq_TLU)) THEN - DEALLOCATE(ParamData%GenTrq_TLU) ENDIF CALL FreeDynamicLib( ParamData%DLL_Trgt, ErrStat, ErrMsg ) CALL TMD_DestroyParam( ParamData%NTMD, ErrStat, ErrMsg ) @@ -4753,7 +5333,6 @@ SUBROUTINE SrvD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_BufSz = 0 Db_BufSz = Db_BufSz + 1 ! DT Db_BufSz = Db_BufSz + 1 ! HSSBrDT - Re_BufSz = Re_BufSz + 1 ! HSSBrFrac Re_BufSz = Re_BufSz + 1 ! HSSBrTqF Re_BufSz = Re_BufSz + 1 ! SIG_POSl Re_BufSz = Re_BufSz + 1 ! SIG_POTq @@ -4790,7 +5369,6 @@ SUBROUTINE SrvD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_BufSz = Int_BufSz + 2*1 ! PitManRat upper/lower bounds for each dimension Re_BufSz = Re_BufSz + SIZE(InData%PitManRat) ! PitManRat END IF - Re_BufSz = Re_BufSz + 1 ! BlAlpha Re_BufSz = Re_BufSz + 1 ! YawManRat Re_BufSz = Re_BufSz + 1 ! NacYawF Re_BufSz = Re_BufSz + 1 ! SpdGenOn @@ -4837,6 +5415,7 @@ SUBROUTINE SrvD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_BufSz = Int_BufSz + 1 ! CompNTMD Int_BufSz = Int_BufSz + 1 ! CompTTMD Int_BufSz = Int_BufSz + 1 ! NumOuts + Int_BufSz = Int_BufSz + 1 ! NumOuts_DLL Int_BufSz = Int_BufSz + 1*LEN(InData%RootName) ! RootName Int_BufSz = Int_BufSz + 1 ! OutParam allocated yes/no IF ( ALLOCATED(InData%OutParam) ) THEN @@ -4864,33 +5443,7 @@ SUBROUTINE SrvD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, END IF Int_BufSz = Int_BufSz + 1*LEN(InData%Delim) ! Delim Int_BufSz = Int_BufSz + 1 ! UseBladedInterface - Int_BufSz = Int_BufSz + 1 ! DLL_Ramp - Db_BufSz = Db_BufSz + 1 ! DLL_DT - Int_BufSz = Int_BufSz + 1 ! DLL_NumTrq - Int_BufSz = Int_BufSz + 1 ! Ptch_Cntrl - Re_BufSz = Re_BufSz + 1 ! Gain_OM - Re_BufSz = Re_BufSz + 1 ! GenPwr_Dem - Re_BufSz = Re_BufSz + 1 ! GenSpd_Dem - Re_BufSz = Re_BufSz + 1 ! GenSpd_MaxOM - Re_BufSz = Re_BufSz + 1 ! GenSpd_MinOM - Int_BufSz = Int_BufSz + 1 ! GenSpd_TLU allocated yes/no - IF ( ALLOCATED(InData%GenSpd_TLU) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! GenSpd_TLU upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%GenSpd_TLU) ! GenSpd_TLU - END IF - Re_BufSz = Re_BufSz + 1 ! GenTrq_Dem - Int_BufSz = Int_BufSz + 1 ! GenTrq_TLU allocated yes/no - IF ( ALLOCATED(InData%GenTrq_TLU) ) THEN - Int_BufSz = Int_BufSz + 2*1 ! GenTrq_TLU upper/lower bounds for each dimension - Re_BufSz = Re_BufSz + SIZE(InData%GenTrq_TLU) ! GenTrq_TLU - END IF - Re_BufSz = Re_BufSz + 1 ! Ptch_Max - Re_BufSz = Re_BufSz + 1 ! Ptch_Min - Re_BufSz = Re_BufSz + 1 ! Ptch_SetPnt - Re_BufSz = Re_BufSz + 1 ! PtchRate_Max - Re_BufSz = Re_BufSz + 1 ! PtchRate_Min - Re_BufSz = Re_BufSz + 1 ! NacYaw_North - Int_BufSz = Int_BufSz + 1*LEN(InData%DLL_InFile) ! DLL_InFile + Int_BufSz = Int_BufSz + 1 ! UseLegacyInterface Int_BufSz = Int_BufSz + 3 ! DLL_Trgt: size of buffers for each call to pack subtype CALL DLLTypePack( InData%DLL_Trgt, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, .TRUE. ) ! DLL_Trgt CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4908,6 +5461,16 @@ SUBROUTINE SrvD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF + Int_BufSz = Int_BufSz + 1 ! DLL_Ramp + Re_BufSz = Re_BufSz + 1 ! BlAlpha + Int_BufSz = Int_BufSz + 1 ! DLL_n + Int_BufSz = Int_BufSz + 1 ! avcOUTNAME_LEN + Re_BufSz = Re_BufSz + 1 ! NacYaw_North + Re_BufSz = Re_BufSz + 1 ! AvgWindSpeed + Re_BufSz = Re_BufSz + 1 ! AirDens + Int_BufSz = Int_BufSz + 1 ! TrimCase + Re_BufSz = Re_BufSz + 1 ! TrimGain + Re_BufSz = Re_BufSz + 1 ! RotSpeedRef Int_BufSz = Int_BufSz + 3 ! NTMD: size of buffers for each call to pack subtype CALL TMD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%NTMD, ErrStat2, ErrMsg2, .TRUE. ) ! NTMD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -4942,8 +5505,6 @@ SUBROUTINE SrvD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Int_BufSz = Int_BufSz + SIZE( Int_Buf ) DEALLOCATE(Int_Buf) END IF - Re_BufSz = Re_BufSz + 1 ! AvgWindSpeed - Re_BufSz = Re_BufSz + 1 ! AirDens IF ( Re_BufSz .GT. 0 ) THEN ALLOCATE( ReKiBuf( Re_BufSz ), STAT=ErrStat2 ) IF (ErrStat2 /= 0) THEN @@ -4971,54 +5532,52 @@ SUBROUTINE SrvD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%HSSBrDT - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HSSBrFrac - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HSSBrTqF - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SIG_POSl - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SIG_POTq - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SIG_SlPc - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SIG_Slop - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SIG_SySp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TEC_A0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TEC_C0 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TEC_C1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TEC_C2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TEC_K2 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TEC_MR - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TEC_Re1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TEC_RLR - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TEC_RRes - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TEC_SRes - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TEC_SySp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TEC_V1a - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TEC_VLL - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TEC_Xe1 - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GenEff - Re_Xferred = Re_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%HSSBrDT + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HSSBrTqF + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SIG_POSl + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SIG_POTq + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SIG_SlPc + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SIG_Slop + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SIG_SySp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TEC_A0 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TEC_C0 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TEC_C1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TEC_C2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TEC_K2 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TEC_MR + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TEC_Re1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TEC_RLR + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TEC_RRes + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TEC_SRes + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TEC_SySp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TEC_V1a + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TEC_VLL + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TEC_Xe1 + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GenEff + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%BlPitchInit) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -5029,8 +5588,10 @@ SUBROUTINE SrvD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlPitchInit,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BlPitchInit)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlPitchInit))-1 ) = PACK(InData%BlPitchInit,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlPitchInit) + DO i1 = LBOUND(InData%BlPitchInit,1), UBOUND(InData%BlPitchInit,1) + ReKiBuf(Re_Xferred) = InData%BlPitchInit(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%BlPitchF) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5042,8 +5603,10 @@ SUBROUTINE SrvD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlPitchF,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BlPitchF)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlPitchF))-1 ) = PACK(InData%BlPitchF,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlPitchF) + DO i1 = LBOUND(InData%BlPitchF,1), UBOUND(InData%BlPitchF,1) + ReKiBuf(Re_Xferred) = InData%BlPitchF(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%PitManRat) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5055,27 +5618,27 @@ SUBROUTINE SrvD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PitManRat,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PitManRat)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PitManRat))-1 ) = PACK(InData%PitManRat,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PitManRat) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%BlAlpha - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawManRat - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NacYawF - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SpdGenOn - Re_Xferred = Re_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%THSSBrDp - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%THSSBrFl - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%TimGenOf - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%TimGenOn - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%TPCOn - Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(InData%PitManRat,1), UBOUND(InData%PitManRat,1) + ReKiBuf(Re_Xferred) = InData%PitManRat(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%YawManRat + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NacYawF + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%SpdGenOn + Re_Xferred = Re_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%THSSBrDp + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%THSSBrFl + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%TimGenOf + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%TimGenOn + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%TPCOn + Db_Xferred = Db_Xferred + 1 IF ( .NOT. ALLOCATED(InData%TPitManS) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -5086,53 +5649,55 @@ SUBROUTINE SrvD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TPitManS,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TPitManS)>0) DbKiBuf ( Db_Xferred:Db_Xferred+(SIZE(InData%TPitManS))-1 ) = PACK(InData%TPitManS,.TRUE.) - Db_Xferred = Db_Xferred + SIZE(InData%TPitManS) - END IF - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%TYawManS - Db_Xferred = Db_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%TYCOn - Db_Xferred = Db_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%VS_RtGnSp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%VS_RtTq - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%VS_Slope - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%VS_SlPc - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%VS_SySp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%VS_TrGnSp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawPosCom - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawRateCom - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%GenModel - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%HSSBrMode - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%PCMode - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%VSContrl - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%YCMode - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%GenTiStp , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%GenTiStr , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%VS_Rgn2K - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawNeut - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawSpr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawDamp - Re_Xferred = Re_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%TpBrDT - Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(InData%TPitManS,1), UBOUND(InData%TPitManS,1) + DbKiBuf(Db_Xferred) = InData%TPitManS(i1) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + DbKiBuf(Db_Xferred) = InData%TYawManS + Db_Xferred = Db_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%TYCOn + Db_Xferred = Db_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VS_RtGnSp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VS_RtTq + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VS_Slope + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VS_SlPc + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VS_SySp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VS_TrGnSp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawPosCom + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawRateCom + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%GenModel + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%HSSBrMode + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%PCMode + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%VSContrl + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%YCMode + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%GenTiStp, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%GenTiStr, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%VS_Rgn2K + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawNeut + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawSpr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawDamp + Re_Xferred = Re_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%TpBrDT + Db_Xferred = Db_Xferred + 1 IF ( .NOT. ALLOCATED(InData%TBDepISp) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -5143,25 +5708,29 @@ SUBROUTINE SrvD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TBDepISp,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TBDepISp)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TBDepISp))-1 ) = PACK(InData%TBDepISp,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TBDepISp) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TBDrConN - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TBDrConD - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumBl - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%CompNTMD , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%CompTTMD , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO i1 = LBOUND(InData%TBDepISp,1), UBOUND(InData%TBDepISp,1) + ReKiBuf(Re_Xferred) = InData%TBDepISp(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%TBDrConN + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TBDrConD + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumBl + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%CompNTMD, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%CompTTMD, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts_DLL + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( .NOT. ALLOCATED(InData%OutParam) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -5203,74 +5772,14 @@ SUBROUTINE SrvD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, ENDIF END DO END IF - DO I = 1, LEN(InData%Delim) - IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%UseBladedInterface , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%DLL_Ramp , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DLL_DT - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DLL_NumTrq - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Ptch_Cntrl - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Gain_OM - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GenPwr_Dem - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GenSpd_Dem - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GenSpd_MaxOM - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GenSpd_MinOM - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%GenSpd_TLU) ) THEN - IntKiBuf( Int_Xferred ) = 0 - Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 - Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GenSpd_TLU,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GenSpd_TLU,1) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%GenSpd_TLU)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GenSpd_TLU))-1 ) = PACK(InData%GenSpd_TLU,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GenSpd_TLU) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GenTrq_Dem - Re_Xferred = Re_Xferred + 1 - IF ( .NOT. ALLOCATED(InData%GenTrq_TLU) ) THEN - IntKiBuf( Int_Xferred ) = 0 + DO I = 1, LEN(InData%Delim) + IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = TRANSFER(InData%UseBladedInterface, IntKiBuf(1)) Int_Xferred = Int_Xferred + 1 - ELSE - IntKiBuf( Int_Xferred ) = 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%UseLegacyInterface, IntKiBuf(1)) Int_Xferred = Int_Xferred + 1 - IntKiBuf( Int_Xferred ) = LBOUND(InData%GenTrq_TLU,1) - IntKiBuf( Int_Xferred + 1) = UBOUND(InData%GenTrq_TLU,1) - Int_Xferred = Int_Xferred + 2 - - IF (SIZE(InData%GenTrq_TLU)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%GenTrq_TLU))-1 ) = PACK(InData%GenTrq_TLU,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%GenTrq_TLU) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Ptch_Max - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Ptch_Min - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Ptch_SetPnt - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtchRate_Max - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%PtchRate_Min - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NacYaw_North - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(InData%DLL_InFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%DLL_InFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I CALL DLLTypePack( InData%DLL_Trgt, Re_Buf, Db_Buf, Int_Buf, ErrStat2, ErrMsg2, OnlySize ) ! DLL_Trgt CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -5299,6 +5808,26 @@ SUBROUTINE SrvD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF + IntKiBuf(Int_Xferred) = TRANSFER(InData%DLL_Ramp, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%BlAlpha + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DLL_n + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%avcOUTNAME_LEN + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NacYaw_North + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AvgWindSpeed + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%AirDens + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TrimCase + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TrimGain + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RotSpeedRef + Re_Xferred = Re_Xferred + 1 CALL TMD_PackParam( Re_Buf, Db_Buf, Int_Buf, InData%NTMD, ErrStat2, ErrMsg2, OnlySize ) ! NTMD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -5355,10 +5884,6 @@ SUBROUTINE SrvD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, ELSE IntKiBuf( Int_Xferred ) = 0; Int_Xferred = Int_Xferred + 1 ENDIF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AvgWindSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%AirDens - Re_Xferred = Re_Xferred + 1 END SUBROUTINE SrvD_PackParam SUBROUTINE SrvD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -5374,12 +5899,6 @@ SUBROUTINE SrvD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -5394,54 +5913,52 @@ SUBROUTINE SrvD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%HSSBrDT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%HSSBrFrac = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HSSBrTqF = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SIG_POSl = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SIG_POTq = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SIG_SlPc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SIG_Slop = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SIG_SySp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_A0 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_C0 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_C1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_C2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_K2 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_MR = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_Re1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_RLR = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_RRes = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_SRes = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_SySp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_V1a = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_VLL = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TEC_Xe1 = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GenEff = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%HSSBrDT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%HSSBrTqF = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SIG_POSl = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SIG_POTq = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SIG_SlPc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SIG_Slop = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SIG_SySp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TEC_A0 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TEC_C0 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TEC_C1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TEC_C2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TEC_K2 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TEC_MR = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TEC_Re1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TEC_RLR = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TEC_RRes = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TEC_SRes = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TEC_SySp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TEC_V1a = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TEC_VLL = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TEC_Xe1 = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GenEff = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlPitchInit not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5455,15 +5972,10 @@ SUBROUTINE SrvD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitchInit.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BlPitchInit)>0) OutData%BlPitchInit = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlPitchInit))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlPitchInit) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BlPitchInit,1), UBOUND(OutData%BlPitchInit,1) + OutData%BlPitchInit(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlPitchF not allocated Int_Xferred = Int_Xferred + 1 @@ -5478,15 +5990,10 @@ SUBROUTINE SrvD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitchF.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BlPitchF)>0) OutData%BlPitchF = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlPitchF))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlPitchF) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BlPitchF,1), UBOUND(OutData%BlPitchF,1) + OutData%BlPitchF(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PitManRat not allocated Int_Xferred = Int_Xferred + 1 @@ -5501,34 +6008,27 @@ SUBROUTINE SrvD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PitManRat.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%PitManRat)>0) OutData%PitManRat = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PitManRat))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PitManRat) - DEALLOCATE(mask1) - END IF - OutData%BlAlpha = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawManRat = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NacYawF = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%SpdGenOn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%THSSBrDp = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%THSSBrFl = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%TimGenOf = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%TimGenOn = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%TPCOn = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(OutData%PitManRat,1), UBOUND(OutData%PitManRat,1) + OutData%PitManRat(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%YawManRat = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NacYawF = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%SpdGenOn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%THSSBrDp = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%THSSBrFl = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%TimGenOf = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%TimGenOn = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%TPCOn = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TPitManS not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5542,60 +6042,55 @@ SUBROUTINE SrvD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TPitManS.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TPitManS)>0) OutData%TPitManS = UNPACK(DbKiBuf( Db_Xferred:Db_Xferred+(SIZE(OutData%TPitManS))-1 ), mask1, 0.0_DbKi ) - Db_Xferred = Db_Xferred + SIZE(OutData%TPitManS) - DEALLOCATE(mask1) - END IF - OutData%TYawManS = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%TYCOn = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%VS_RtGnSp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%VS_RtTq = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%VS_Slope = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%VS_SlPc = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%VS_SySp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%VS_TrGnSp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawPosCom = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawRateCom = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GenModel = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%HSSBrMode = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%PCMode = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%VSContrl = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%YCMode = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%GenTiStp = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%GenTiStr = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%VS_Rgn2K = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawNeut = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawSpr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawDamp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TpBrDT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 + DO i1 = LBOUND(OutData%TPitManS,1), UBOUND(OutData%TPitManS,1) + OutData%TPitManS(i1) = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + END DO + END IF + OutData%TYawManS = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%TYCOn = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%VS_RtGnSp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%VS_RtTq = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%VS_Slope = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%VS_SlPc = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%VS_SySp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%VS_TrGnSp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawPosCom = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawRateCom = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GenModel = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%HSSBrMode = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%PCMode = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%VSContrl = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%YCMode = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%GenTiStp = TRANSFER(IntKiBuf(Int_Xferred), OutData%GenTiStp) + Int_Xferred = Int_Xferred + 1 + OutData%GenTiStr = TRANSFER(IntKiBuf(Int_Xferred), OutData%GenTiStr) + Int_Xferred = Int_Xferred + 1 + OutData%VS_Rgn2K = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawNeut = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawSpr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawDamp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TpBrDT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TBDepISp not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5609,32 +6104,29 @@ SUBROUTINE SrvD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TBDepISp.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TBDepISp)>0) OutData%TBDepISp = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TBDepISp))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TBDepISp) - DEALLOCATE(mask1) - END IF - OutData%TBDrConN = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TBDrConD = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NumBl = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%CompNTMD = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%CompTTMD = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO i1 = LBOUND(OutData%TBDepISp,1), UBOUND(OutData%TBDepISp,1) + OutData%TBDepISp(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%TBDrConN = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TBDrConD = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NumBl = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%CompNTMD = TRANSFER(IntKiBuf(Int_Xferred), OutData%CompNTMD) + Int_Xferred = Int_Xferred + 1 + OutData%CompTTMD = TRANSFER(IntKiBuf(Int_Xferred), OutData%CompTTMD) + Int_Xferred = Int_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumOuts_DLL = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OutParam not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5691,94 +6183,14 @@ SUBROUTINE SrvD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - DO I = 1, LEN(OutData%Delim) - OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%UseBladedInterface = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%DLL_Ramp = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%DLL_DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%DLL_NumTrq = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%Ptch_Cntrl = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%Gain_OM = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GenPwr_Dem = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GenSpd_Dem = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GenSpd_MaxOM = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GenSpd_MinOM = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GenSpd_TLU not allocated - Int_Xferred = Int_Xferred + 1 - ELSE - Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%GenSpd_TLU)) DEALLOCATE(OutData%GenSpd_TLU) - ALLOCATE(OutData%GenSpd_TLU(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GenSpd_TLU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%GenSpd_TLU)>0) OutData%GenSpd_TLU = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GenSpd_TLU))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GenSpd_TLU) - DEALLOCATE(mask1) - END IF - OutData%GenTrq_Dem = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! GenTrq_TLU not allocated + DO I = 1, LEN(OutData%Delim) + OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%UseBladedInterface = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseBladedInterface) Int_Xferred = Int_Xferred + 1 - ELSE + OutData%UseLegacyInterface = TRANSFER(IntKiBuf(Int_Xferred), OutData%UseLegacyInterface) Int_Xferred = Int_Xferred + 1 - i1_l = IntKiBuf( Int_Xferred ) - i1_u = IntKiBuf( Int_Xferred + 1) - Int_Xferred = Int_Xferred + 2 - IF (ALLOCATED(OutData%GenTrq_TLU)) DEALLOCATE(OutData%GenTrq_TLU) - ALLOCATE(OutData%GenTrq_TLU(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%GenTrq_TLU.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%GenTrq_TLU)>0) OutData%GenTrq_TLU = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%GenTrq_TLU))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%GenTrq_TLU) - DEALLOCATE(mask1) - END IF - OutData%Ptch_Max = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Ptch_Min = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Ptch_SetPnt = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtchRate_Max = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%PtchRate_Min = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NacYaw_North = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - DO I = 1, LEN(OutData%DLL_InFile) - OutData%DLL_InFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -5819,6 +6231,26 @@ SUBROUTINE SrvD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) + OutData%DLL_Ramp = TRANSFER(IntKiBuf(Int_Xferred), OutData%DLL_Ramp) + Int_Xferred = Int_Xferred + 1 + OutData%BlAlpha = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%DLL_n = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%avcOUTNAME_LEN = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NacYaw_North = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%AvgWindSpeed = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%AirDens = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TrimCase = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TrimGain = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RotSpeedRef = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -5899,10 +6331,6 @@ SUBROUTINE SrvD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs IF(ALLOCATED(Re_Buf )) DEALLOCATE(Re_Buf ) IF(ALLOCATED(Db_Buf )) DEALLOCATE(Db_Buf ) IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) - OutData%AvgWindSpeed = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%AirDens = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 END SUBROUTINE SrvD_UnPackParam SUBROUTINE SrvD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -5975,8 +6403,6 @@ SUBROUTINE SrvD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg DstInputData%RotPwr = SrcInputData%RotPwr DstInputData%HorWindV = SrcInputData%HorWindV DstInputData%YawAngle = SrcInputData%YawAngle - DstInputData%ElecPwr_prev = SrcInputData%ElecPwr_prev - DstInputData%GenTrq_prev = SrcInputData%GenTrq_prev CALL TMD_CopyInput( SrcInputData%NTMD, DstInputData%NTMD, CtrlCode, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ErrStat>=AbortErrLev) RETURN @@ -6095,8 +6521,6 @@ SUBROUTINE SrvD_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Re_BufSz = Re_BufSz + 1 ! RotPwr Re_BufSz = Re_BufSz + 1 ! HorWindV Re_BufSz = Re_BufSz + 1 ! YawAngle - Re_BufSz = Re_BufSz + 1 ! ElecPwr_prev - Re_BufSz = Re_BufSz + 1 ! GenTrq_prev ! Allocate buffers for subtypes, if any (we'll get sizes from these) Int_BufSz = Int_BufSz + 3 ! NTMD: size of buffers for each call to pack subtype CALL TMD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%NTMD, ErrStat2, ErrMsg2, .TRUE. ) ! NTMD @@ -6174,23 +6598,25 @@ SUBROUTINE SrvD_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlPitch,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BlPitch)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlPitch))-1 ) = PACK(InData%BlPitch,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlPitch) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Yaw - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawRate - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%LSS_Spd - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HSS_Spd - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RotSpeed - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ExternalYawPosCom - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ExternalYawRateCom - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%BlPitch,1), UBOUND(InData%BlPitch,1) + ReKiBuf(Re_Xferred) = InData%BlPitch(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%Yaw + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawRate + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%LSS_Spd + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HSS_Spd + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RotSpeed + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%ExternalYawPosCom + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%ExternalYawRateCom + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%ExternalBlPitchCom) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -6201,61 +6627,63 @@ SUBROUTINE SrvD_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ExternalBlPitchCom,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ExternalBlPitchCom)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%ExternalBlPitchCom))-1 ) = PACK(InData%ExternalBlPitchCom,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%ExternalBlPitchCom) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ExternalGenTrq - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ExternalElecPwr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ExternalHSSBrFrac - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TwrAccel - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawErr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WindDir - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RootMyc))-1 ) = PACK(InData%RootMyc,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RootMyc) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawBrTAxp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawBrTAyp - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%LSSTipPxa - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%RootMxc))-1 ) = PACK(InData%RootMxc,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%RootMxc) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%LSSTipMxa - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%LSSTipMya - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%LSSTipMza - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%LSSTipMys - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%LSSTipMzs - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawBrMyn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawBrMzn - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NcIMURAxs - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NcIMURAys - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%NcIMURAzs - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%RotPwr - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HorWindV - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawAngle - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ElecPwr_prev - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GenTrq_prev - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%ExternalBlPitchCom,1), UBOUND(InData%ExternalBlPitchCom,1) + ReKiBuf(Re_Xferred) = InData%ExternalBlPitchCom(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%ExternalGenTrq + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%ExternalElecPwr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%ExternalHSSBrFrac + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TwrAccel + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawErr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%WindDir + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%RootMyc,1), UBOUND(InData%RootMyc,1) + ReKiBuf(Re_Xferred) = InData%RootMyc(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%YawBrTAxp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawBrTAyp + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%LSSTipPxa + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%RootMxc,1), UBOUND(InData%RootMxc,1) + ReKiBuf(Re_Xferred) = InData%RootMxc(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%LSSTipMxa + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%LSSTipMya + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%LSSTipMza + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%LSSTipMys + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%LSSTipMzs + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawBrMyn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawBrMzn + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NcIMURAxs + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NcIMURAys + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%NcIMURAzs + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%RotPwr + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HorWindV + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%YawAngle + Re_Xferred = Re_Xferred + 1 CALL TMD_PackInput( Re_Buf, Db_Buf, Int_Buf, InData%NTMD, ErrStat2, ErrMsg2, OnlySize ) ! NTMD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) IF (ErrStat >= AbortErrLev) RETURN @@ -6322,8 +6750,10 @@ SUBROUTINE SrvD_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SuperController,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%SuperController)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SuperController))-1 ) = PACK(InData%SuperController,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SuperController) + DO i1 = LBOUND(InData%SuperController,1), UBOUND(InData%SuperController,1) + ReKiBuf(Re_Xferred) = InData%SuperController(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE SrvD_PackInput @@ -6340,12 +6770,6 @@ SUBROUTINE SrvD_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -6373,30 +6797,25 @@ SUBROUTINE SrvD_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitch.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BlPitch)>0) OutData%BlPitch = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlPitch))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlPitch) - DEALLOCATE(mask1) - END IF - OutData%Yaw = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawRate = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%LSS_Spd = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HSS_Spd = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RotSpeed = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%ExternalYawPosCom = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%ExternalYawRateCom = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%BlPitch,1), UBOUND(OutData%BlPitch,1) + OutData%BlPitch(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%Yaw = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawRate = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LSS_Spd = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HSS_Spd = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RotSpeed = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%ExternalYawPosCom = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%ExternalYawRateCom = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ExternalBlPitchCom not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -6410,86 +6829,67 @@ SUBROUTINE SrvD_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ExternalBlPitchCom.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%ExternalBlPitchCom)>0) OutData%ExternalBlPitchCom = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%ExternalBlPitchCom))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%ExternalBlPitchCom) - DEALLOCATE(mask1) - END IF - OutData%ExternalGenTrq = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%ExternalElecPwr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%ExternalHSSBrFrac = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TwrAccel = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawErr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%WindDir = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%ExternalBlPitchCom,1), UBOUND(OutData%ExternalBlPitchCom,1) + OutData%ExternalBlPitchCom(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%ExternalGenTrq = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%ExternalElecPwr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%ExternalHSSBrFrac = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TwrAccel = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawErr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%WindDir = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%RootMyc,1) i1_u = UBOUND(OutData%RootMyc,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%RootMyc = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RootMyc))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RootMyc) - DEALLOCATE(mask1) - OutData%YawBrTAxp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawBrTAyp = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipPxa = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%RootMyc,1), UBOUND(OutData%RootMyc,1) + OutData%RootMyc(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%YawBrTAxp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawBrTAyp = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LSSTipPxa = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%RootMxc,1) i1_u = UBOUND(OutData%RootMxc,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%RootMxc = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%RootMxc))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%RootMxc) - DEALLOCATE(mask1) - OutData%LSSTipMxa = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipMya = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipMza = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipMys = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%LSSTipMzs = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawBrMyn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawBrMzn = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NcIMURAxs = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NcIMURAys = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%NcIMURAzs = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%RotPwr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HorWindV = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%YawAngle = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%ElecPwr_prev = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GenTrq_prev = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%RootMxc,1), UBOUND(OutData%RootMxc,1) + OutData%RootMxc(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%LSSTipMxa = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LSSTipMya = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LSSTipMza = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LSSTipMys = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%LSSTipMzs = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawBrMyn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawBrMzn = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NcIMURAxs = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NcIMURAys = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%NcIMURAzs = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%RotPwr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HorWindV = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%YawAngle = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 IF(Buf_size > 0) THEN @@ -6583,15 +6983,10 @@ SUBROUTINE SrvD_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SuperController.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%SuperController)>0) OutData%SuperController = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SuperController))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%SuperController) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%SuperController,1), UBOUND(OutData%SuperController,1) + OutData%SuperController(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE SrvD_UnPackInput @@ -6846,8 +7241,10 @@ SUBROUTINE SrvD_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WriteOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WriteOutput))-1 ) = PACK(InData%WriteOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WriteOutput) + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%BlPitchCom) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6859,8 +7256,10 @@ SUBROUTINE SrvD_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlPitchCom,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BlPitchCom)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlPitchCom))-1 ) = PACK(InData%BlPitchCom,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlPitchCom) + DO i1 = LBOUND(InData%BlPitchCom,1), UBOUND(InData%BlPitchCom,1) + ReKiBuf(Re_Xferred) = InData%BlPitchCom(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%BlAirfoilCom) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6872,17 +7271,19 @@ SUBROUTINE SrvD_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BlAirfoilCom,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BlAirfoilCom)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%BlAirfoilCom))-1 ) = PACK(InData%BlAirfoilCom,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%BlAirfoilCom) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YawMom - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%GenTrq - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%HSSBrTrqC - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ElecPwr - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%BlAirfoilCom,1), UBOUND(InData%BlAirfoilCom,1) + ReKiBuf(Re_Xferred) = InData%BlAirfoilCom(i1) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + ReKiBuf(Re_Xferred) = InData%YawMom + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%GenTrq + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%HSSBrTrqC + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%ElecPwr + Re_Xferred = Re_Xferred + 1 IF ( .NOT. ALLOCATED(InData%TBDrCon) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -6893,8 +7294,10 @@ SUBROUTINE SrvD_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TBDrCon,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TBDrCon)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TBDrCon))-1 ) = PACK(InData%TBDrCon,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TBDrCon) + DO i1 = LBOUND(InData%TBDrCon,1), UBOUND(InData%TBDrCon,1) + ReKiBuf(Re_Xferred) = InData%TBDrCon(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF CALL TMD_PackOutput( Re_Buf, Db_Buf, Int_Buf, InData%NTMD, ErrStat2, ErrMsg2, OnlySize ) ! NTMD CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName) @@ -6962,8 +7365,10 @@ SUBROUTINE SrvD_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SuperController,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%SuperController)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SuperController))-1 ) = PACK(InData%SuperController,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SuperController) + DO i1 = LBOUND(InData%SuperController,1), UBOUND(InData%SuperController,1) + ReKiBuf(Re_Xferred) = InData%SuperController(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE SrvD_PackOutput @@ -6980,12 +7385,6 @@ SUBROUTINE SrvD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -7013,15 +7412,10 @@ SUBROUTINE SrvD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WriteOutput)>0) OutData%WriteOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WriteOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WriteOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlPitchCom not allocated Int_Xferred = Int_Xferred + 1 @@ -7036,15 +7430,10 @@ SUBROUTINE SrvD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlPitchCom.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BlPitchCom)>0) OutData%BlPitchCom = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlPitchCom))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlPitchCom) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%BlPitchCom,1), UBOUND(OutData%BlPitchCom,1) + OutData%BlPitchCom(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BlAirfoilCom not allocated Int_Xferred = Int_Xferred + 1 @@ -7059,24 +7448,19 @@ SUBROUTINE SrvD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BlAirfoilCom.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%BlAirfoilCom)>0) OutData%BlAirfoilCom = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%BlAirfoilCom))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%BlAirfoilCom) - DEALLOCATE(mask1) - END IF - OutData%YawMom = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%GenTrq = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%HSSBrTrqC = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%ElecPwr = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%BlAirfoilCom,1), UBOUND(OutData%BlAirfoilCom,1) + OutData%BlAirfoilCom(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END IF + OutData%YawMom = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%GenTrq = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%HSSBrTrqC = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%ElecPwr = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TBDrCon not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -7090,15 +7474,10 @@ SUBROUTINE SrvD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TBDrCon.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%TBDrCon)>0) OutData%TBDrCon = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TBDrCon))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TBDrCon) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%TBDrCon,1), UBOUND(OutData%TBDrCon,1) + OutData%TBDrCon(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -7193,15 +7572,10 @@ SUBROUTINE SrvD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SuperController.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%SuperController)>0) OutData%SuperController = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SuperController))-1 ), mask1, 0.0_ReKi ), SiKi) - Re_Xferred = Re_Xferred + SIZE(OutData%SuperController) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%SuperController,1), UBOUND(OutData%SuperController,1) + OutData%SuperController(i1) = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE SrvD_UnPackOutput @@ -7280,12 +7654,12 @@ SUBROUTINE SrvD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -7298,107 +7672,88 @@ SUBROUTINE SrvD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) IF (ALLOCATED(u_out%BlPitch) .AND. ALLOCATED(u1%BlPitch)) THEN - ALLOCATE(b1(SIZE(u_out%BlPitch,1))) - ALLOCATE(c1(SIZE(u_out%BlPitch,1))) - b1 = -(u1%BlPitch - u2%BlPitch)/t(2) - u_out%BlPitch = u1%BlPitch + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%BlPitch,1),UBOUND(u_out%BlPitch,1) + CALL Angles_ExtrapInterp( u1%BlPitch(i1), u2%BlPitch(i1), tin, u_out%BlPitch(i1), tin_out ) + END DO END IF ! check if allocated - b0 = -(u1%Yaw - u2%Yaw)/t(2) - u_out%Yaw = u1%Yaw + b0 * t_out - b0 = -(u1%YawRate - u2%YawRate)/t(2) - u_out%YawRate = u1%YawRate + b0 * t_out - b0 = -(u1%LSS_Spd - u2%LSS_Spd)/t(2) - u_out%LSS_Spd = u1%LSS_Spd + b0 * t_out - b0 = -(u1%HSS_Spd - u2%HSS_Spd)/t(2) - u_out%HSS_Spd = u1%HSS_Spd + b0 * t_out - b0 = -(u1%RotSpeed - u2%RotSpeed)/t(2) - u_out%RotSpeed = u1%RotSpeed + b0 * t_out - b0 = -(u1%ExternalYawPosCom - u2%ExternalYawPosCom)/t(2) - u_out%ExternalYawPosCom = u1%ExternalYawPosCom + b0 * t_out - b0 = -(u1%ExternalYawRateCom - u2%ExternalYawRateCom)/t(2) - u_out%ExternalYawRateCom = u1%ExternalYawRateCom + b0 * t_out + CALL Angles_ExtrapInterp( u1%Yaw, u2%Yaw, tin, u_out%Yaw, tin_out ) + b = -(u1%YawRate - u2%YawRate) + u_out%YawRate = u1%YawRate + b * ScaleFactor + b = -(u1%LSS_Spd - u2%LSS_Spd) + u_out%LSS_Spd = u1%LSS_Spd + b * ScaleFactor + b = -(u1%HSS_Spd - u2%HSS_Spd) + u_out%HSS_Spd = u1%HSS_Spd + b * ScaleFactor + b = -(u1%RotSpeed - u2%RotSpeed) + u_out%RotSpeed = u1%RotSpeed + b * ScaleFactor + CALL Angles_ExtrapInterp( u1%ExternalYawPosCom, u2%ExternalYawPosCom, tin, u_out%ExternalYawPosCom, tin_out ) + b = -(u1%ExternalYawRateCom - u2%ExternalYawRateCom) + u_out%ExternalYawRateCom = u1%ExternalYawRateCom + b * ScaleFactor IF (ALLOCATED(u_out%ExternalBlPitchCom) .AND. ALLOCATED(u1%ExternalBlPitchCom)) THEN - ALLOCATE(b1(SIZE(u_out%ExternalBlPitchCom,1))) - ALLOCATE(c1(SIZE(u_out%ExternalBlPitchCom,1))) - b1 = -(u1%ExternalBlPitchCom - u2%ExternalBlPitchCom)/t(2) - u_out%ExternalBlPitchCom = u1%ExternalBlPitchCom + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%ExternalBlPitchCom,1),UBOUND(u_out%ExternalBlPitchCom,1) + CALL Angles_ExtrapInterp( u1%ExternalBlPitchCom(i1), u2%ExternalBlPitchCom(i1), tin, u_out%ExternalBlPitchCom(i1), tin_out ) + END DO END IF ! check if allocated - b0 = -(u1%ExternalGenTrq - u2%ExternalGenTrq)/t(2) - u_out%ExternalGenTrq = u1%ExternalGenTrq + b0 * t_out - b0 = -(u1%ExternalElecPwr - u2%ExternalElecPwr)/t(2) - u_out%ExternalElecPwr = u1%ExternalElecPwr + b0 * t_out - b0 = -(u1%ExternalHSSBrFrac - u2%ExternalHSSBrFrac)/t(2) - u_out%ExternalHSSBrFrac = u1%ExternalHSSBrFrac + b0 * t_out - b0 = -(u1%TwrAccel - u2%TwrAccel)/t(2) - u_out%TwrAccel = u1%TwrAccel + b0 * t_out - b0 = -(u1%YawErr - u2%YawErr)/t(2) - u_out%YawErr = u1%YawErr + b0 * t_out - b0 = -(u1%WindDir - u2%WindDir)/t(2) - u_out%WindDir = u1%WindDir + b0 * t_out - ALLOCATE(b1(SIZE(u_out%RootMyc,1))) - ALLOCATE(c1(SIZE(u_out%RootMyc,1))) - b1 = -(u1%RootMyc - u2%RootMyc)/t(2) - u_out%RootMyc = u1%RootMyc + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - b0 = -(u1%YawBrTAxp - u2%YawBrTAxp)/t(2) - u_out%YawBrTAxp = u1%YawBrTAxp + b0 * t_out - b0 = -(u1%YawBrTAyp - u2%YawBrTAyp)/t(2) - u_out%YawBrTAyp = u1%YawBrTAyp + b0 * t_out - b0 = -(u1%LSSTipPxa - u2%LSSTipPxa)/t(2) - u_out%LSSTipPxa = u1%LSSTipPxa + b0 * t_out - ALLOCATE(b1(SIZE(u_out%RootMxc,1))) - ALLOCATE(c1(SIZE(u_out%RootMxc,1))) - b1 = -(u1%RootMxc - u2%RootMxc)/t(2) - u_out%RootMxc = u1%RootMxc + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) - b0 = -(u1%LSSTipMxa - u2%LSSTipMxa)/t(2) - u_out%LSSTipMxa = u1%LSSTipMxa + b0 * t_out - b0 = -(u1%LSSTipMya - u2%LSSTipMya)/t(2) - u_out%LSSTipMya = u1%LSSTipMya + b0 * t_out - b0 = -(u1%LSSTipMza - u2%LSSTipMza)/t(2) - u_out%LSSTipMza = u1%LSSTipMza + b0 * t_out - b0 = -(u1%LSSTipMys - u2%LSSTipMys)/t(2) - u_out%LSSTipMys = u1%LSSTipMys + b0 * t_out - b0 = -(u1%LSSTipMzs - u2%LSSTipMzs)/t(2) - u_out%LSSTipMzs = u1%LSSTipMzs + b0 * t_out - b0 = -(u1%YawBrMyn - u2%YawBrMyn)/t(2) - u_out%YawBrMyn = u1%YawBrMyn + b0 * t_out - b0 = -(u1%YawBrMzn - u2%YawBrMzn)/t(2) - u_out%YawBrMzn = u1%YawBrMzn + b0 * t_out - b0 = -(u1%NcIMURAxs - u2%NcIMURAxs)/t(2) - u_out%NcIMURAxs = u1%NcIMURAxs + b0 * t_out - b0 = -(u1%NcIMURAys - u2%NcIMURAys)/t(2) - u_out%NcIMURAys = u1%NcIMURAys + b0 * t_out - b0 = -(u1%NcIMURAzs - u2%NcIMURAzs)/t(2) - u_out%NcIMURAzs = u1%NcIMURAzs + b0 * t_out - b0 = -(u1%RotPwr - u2%RotPwr)/t(2) - u_out%RotPwr = u1%RotPwr + b0 * t_out - b0 = -(u1%HorWindV - u2%HorWindV)/t(2) - u_out%HorWindV = u1%HorWindV + b0 * t_out - b0 = -(u1%YawAngle - u2%YawAngle)/t(2) - u_out%YawAngle = u1%YawAngle + b0 * t_out - b0 = -(u1%ElecPwr_prev - u2%ElecPwr_prev)/t(2) - u_out%ElecPwr_prev = u1%ElecPwr_prev + b0 * t_out - b0 = -(u1%GenTrq_prev - u2%GenTrq_prev)/t(2) - u_out%GenTrq_prev = u1%GenTrq_prev + b0 * t_out + b = -(u1%ExternalGenTrq - u2%ExternalGenTrq) + u_out%ExternalGenTrq = u1%ExternalGenTrq + b * ScaleFactor + b = -(u1%ExternalElecPwr - u2%ExternalElecPwr) + u_out%ExternalElecPwr = u1%ExternalElecPwr + b * ScaleFactor + b = -(u1%ExternalHSSBrFrac - u2%ExternalHSSBrFrac) + u_out%ExternalHSSBrFrac = u1%ExternalHSSBrFrac + b * ScaleFactor + b = -(u1%TwrAccel - u2%TwrAccel) + u_out%TwrAccel = u1%TwrAccel + b * ScaleFactor + CALL Angles_ExtrapInterp( u1%YawErr, u2%YawErr, tin, u_out%YawErr, tin_out ) + CALL Angles_ExtrapInterp( u1%WindDir, u2%WindDir, tin, u_out%WindDir, tin_out ) + DO i1 = LBOUND(u_out%RootMyc,1),UBOUND(u_out%RootMyc,1) + b = -(u1%RootMyc(i1) - u2%RootMyc(i1)) + u_out%RootMyc(i1) = u1%RootMyc(i1) + b * ScaleFactor + END DO + b = -(u1%YawBrTAxp - u2%YawBrTAxp) + u_out%YawBrTAxp = u1%YawBrTAxp + b * ScaleFactor + b = -(u1%YawBrTAyp - u2%YawBrTAyp) + u_out%YawBrTAyp = u1%YawBrTAyp + b * ScaleFactor + b = -(u1%LSSTipPxa - u2%LSSTipPxa) + u_out%LSSTipPxa = u1%LSSTipPxa + b * ScaleFactor + DO i1 = LBOUND(u_out%RootMxc,1),UBOUND(u_out%RootMxc,1) + b = -(u1%RootMxc(i1) - u2%RootMxc(i1)) + u_out%RootMxc(i1) = u1%RootMxc(i1) + b * ScaleFactor + END DO + b = -(u1%LSSTipMxa - u2%LSSTipMxa) + u_out%LSSTipMxa = u1%LSSTipMxa + b * ScaleFactor + b = -(u1%LSSTipMya - u2%LSSTipMya) + u_out%LSSTipMya = u1%LSSTipMya + b * ScaleFactor + b = -(u1%LSSTipMza - u2%LSSTipMza) + u_out%LSSTipMza = u1%LSSTipMza + b * ScaleFactor + b = -(u1%LSSTipMys - u2%LSSTipMys) + u_out%LSSTipMys = u1%LSSTipMys + b * ScaleFactor + b = -(u1%LSSTipMzs - u2%LSSTipMzs) + u_out%LSSTipMzs = u1%LSSTipMzs + b * ScaleFactor + b = -(u1%YawBrMyn - u2%YawBrMyn) + u_out%YawBrMyn = u1%YawBrMyn + b * ScaleFactor + b = -(u1%YawBrMzn - u2%YawBrMzn) + u_out%YawBrMzn = u1%YawBrMzn + b * ScaleFactor + b = -(u1%NcIMURAxs - u2%NcIMURAxs) + u_out%NcIMURAxs = u1%NcIMURAxs + b * ScaleFactor + b = -(u1%NcIMURAys - u2%NcIMURAys) + u_out%NcIMURAys = u1%NcIMURAys + b * ScaleFactor + b = -(u1%NcIMURAzs - u2%NcIMURAzs) + u_out%NcIMURAzs = u1%NcIMURAzs + b * ScaleFactor + b = -(u1%RotPwr - u2%RotPwr) + u_out%RotPwr = u1%RotPwr + b * ScaleFactor + b = -(u1%HorWindV - u2%HorWindV) + u_out%HorWindV = u1%HorWindV + b * ScaleFactor + CALL Angles_ExtrapInterp( u1%YawAngle, u2%YawAngle, tin, u_out%YawAngle, tin_out ) CALL TMD_Input_ExtrapInterp1( u1%NTMD, u2%NTMD, tin, u_out%NTMD, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL TMD_Input_ExtrapInterp1( u1%TTMD, u2%TTMD, tin, u_out%TTMD, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(u_out%SuperController) .AND. ALLOCATED(u1%SuperController)) THEN - ALLOCATE(b1(SIZE(u_out%SuperController,1))) - ALLOCATE(c1(SIZE(u_out%SuperController,1))) - b1 = -(u1%SuperController - u2%SuperController)/t(2) - u_out%SuperController = u1%SuperController + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%SuperController,1),UBOUND(u_out%SuperController,1) + b = -(u1%SuperController(i1) - u2%SuperController(i1)) + u_out%SuperController(i1) = u1%SuperController(i1) + b * ScaleFactor + END DO END IF ! check if allocated END SUBROUTINE SrvD_Input_ExtrapInterp1 @@ -7429,13 +7784,14 @@ SUBROUTINE SrvD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -7454,143 +7810,115 @@ SUBROUTINE SrvD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) IF (ALLOCATED(u_out%BlPitch) .AND. ALLOCATED(u1%BlPitch)) THEN - ALLOCATE(b1(SIZE(u_out%BlPitch,1))) - ALLOCATE(c1(SIZE(u_out%BlPitch,1))) - b1 = (t(3)**2*(u1%BlPitch - u2%BlPitch) + t(2)**2*(-u1%BlPitch + u3%BlPitch))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%BlPitch + t(3)*u2%BlPitch - t(2)*u3%BlPitch ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%BlPitch = u1%BlPitch + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%BlPitch,1),UBOUND(u_out%BlPitch,1) + CALL Angles_ExtrapInterp( u1%BlPitch(i1), u2%BlPitch(i1), u3%BlPitch(i1), tin, u_out%BlPitch(i1), tin_out ) + END DO END IF ! check if allocated - b0 = (t(3)**2*(u1%Yaw - u2%Yaw) + t(2)**2*(-u1%Yaw + u3%Yaw))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%Yaw + t(3)*u2%Yaw - t(2)*u3%Yaw ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%Yaw = u1%Yaw + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%YawRate - u2%YawRate) + t(2)**2*(-u1%YawRate + u3%YawRate))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%YawRate + t(3)*u2%YawRate - t(2)*u3%YawRate ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%YawRate = u1%YawRate + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%LSS_Spd - u2%LSS_Spd) + t(2)**2*(-u1%LSS_Spd + u3%LSS_Spd))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%LSS_Spd + t(3)*u2%LSS_Spd - t(2)*u3%LSS_Spd ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%LSS_Spd = u1%LSS_Spd + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%HSS_Spd - u2%HSS_Spd) + t(2)**2*(-u1%HSS_Spd + u3%HSS_Spd))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%HSS_Spd + t(3)*u2%HSS_Spd - t(2)*u3%HSS_Spd ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%HSS_Spd = u1%HSS_Spd + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%RotSpeed - u2%RotSpeed) + t(2)**2*(-u1%RotSpeed + u3%RotSpeed))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%RotSpeed + t(3)*u2%RotSpeed - t(2)*u3%RotSpeed ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%RotSpeed = u1%RotSpeed + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%ExternalYawPosCom - u2%ExternalYawPosCom) + t(2)**2*(-u1%ExternalYawPosCom + u3%ExternalYawPosCom))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%ExternalYawPosCom + t(3)*u2%ExternalYawPosCom - t(2)*u3%ExternalYawPosCom ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%ExternalYawPosCom = u1%ExternalYawPosCom + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%ExternalYawRateCom - u2%ExternalYawRateCom) + t(2)**2*(-u1%ExternalYawRateCom + u3%ExternalYawRateCom))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%ExternalYawRateCom + t(3)*u2%ExternalYawRateCom - t(2)*u3%ExternalYawRateCom ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%ExternalYawRateCom = u1%ExternalYawRateCom + b0 * t_out + c0 * t_out**2 + CALL Angles_ExtrapInterp( u1%Yaw, u2%Yaw, u3%Yaw, tin, u_out%Yaw, tin_out ) + b = (t(3)**2*(u1%YawRate - u2%YawRate) + t(2)**2*(-u1%YawRate + u3%YawRate))* scaleFactor + c = ( (t(2)-t(3))*u1%YawRate + t(3)*u2%YawRate - t(2)*u3%YawRate ) * scaleFactor + u_out%YawRate = u1%YawRate + b + c * t_out + b = (t(3)**2*(u1%LSS_Spd - u2%LSS_Spd) + t(2)**2*(-u1%LSS_Spd + u3%LSS_Spd))* scaleFactor + c = ( (t(2)-t(3))*u1%LSS_Spd + t(3)*u2%LSS_Spd - t(2)*u3%LSS_Spd ) * scaleFactor + u_out%LSS_Spd = u1%LSS_Spd + b + c * t_out + b = (t(3)**2*(u1%HSS_Spd - u2%HSS_Spd) + t(2)**2*(-u1%HSS_Spd + u3%HSS_Spd))* scaleFactor + c = ( (t(2)-t(3))*u1%HSS_Spd + t(3)*u2%HSS_Spd - t(2)*u3%HSS_Spd ) * scaleFactor + u_out%HSS_Spd = u1%HSS_Spd + b + c * t_out + b = (t(3)**2*(u1%RotSpeed - u2%RotSpeed) + t(2)**2*(-u1%RotSpeed + u3%RotSpeed))* scaleFactor + c = ( (t(2)-t(3))*u1%RotSpeed + t(3)*u2%RotSpeed - t(2)*u3%RotSpeed ) * scaleFactor + u_out%RotSpeed = u1%RotSpeed + b + c * t_out + CALL Angles_ExtrapInterp( u1%ExternalYawPosCom, u2%ExternalYawPosCom, u3%ExternalYawPosCom, tin, u_out%ExternalYawPosCom, tin_out ) + b = (t(3)**2*(u1%ExternalYawRateCom - u2%ExternalYawRateCom) + t(2)**2*(-u1%ExternalYawRateCom + u3%ExternalYawRateCom))* scaleFactor + c = ( (t(2)-t(3))*u1%ExternalYawRateCom + t(3)*u2%ExternalYawRateCom - t(2)*u3%ExternalYawRateCom ) * scaleFactor + u_out%ExternalYawRateCom = u1%ExternalYawRateCom + b + c * t_out IF (ALLOCATED(u_out%ExternalBlPitchCom) .AND. ALLOCATED(u1%ExternalBlPitchCom)) THEN - ALLOCATE(b1(SIZE(u_out%ExternalBlPitchCom,1))) - ALLOCATE(c1(SIZE(u_out%ExternalBlPitchCom,1))) - b1 = (t(3)**2*(u1%ExternalBlPitchCom - u2%ExternalBlPitchCom) + t(2)**2*(-u1%ExternalBlPitchCom + u3%ExternalBlPitchCom))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%ExternalBlPitchCom + t(3)*u2%ExternalBlPitchCom - t(2)*u3%ExternalBlPitchCom ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%ExternalBlPitchCom = u1%ExternalBlPitchCom + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%ExternalBlPitchCom,1),UBOUND(u_out%ExternalBlPitchCom,1) + CALL Angles_ExtrapInterp( u1%ExternalBlPitchCom(i1), u2%ExternalBlPitchCom(i1), u3%ExternalBlPitchCom(i1), tin, u_out%ExternalBlPitchCom(i1), tin_out ) + END DO END IF ! check if allocated - b0 = (t(3)**2*(u1%ExternalGenTrq - u2%ExternalGenTrq) + t(2)**2*(-u1%ExternalGenTrq + u3%ExternalGenTrq))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%ExternalGenTrq + t(3)*u2%ExternalGenTrq - t(2)*u3%ExternalGenTrq ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%ExternalGenTrq = u1%ExternalGenTrq + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%ExternalElecPwr - u2%ExternalElecPwr) + t(2)**2*(-u1%ExternalElecPwr + u3%ExternalElecPwr))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%ExternalElecPwr + t(3)*u2%ExternalElecPwr - t(2)*u3%ExternalElecPwr ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%ExternalElecPwr = u1%ExternalElecPwr + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%ExternalHSSBrFrac - u2%ExternalHSSBrFrac) + t(2)**2*(-u1%ExternalHSSBrFrac + u3%ExternalHSSBrFrac))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%ExternalHSSBrFrac + t(3)*u2%ExternalHSSBrFrac - t(2)*u3%ExternalHSSBrFrac ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%ExternalHSSBrFrac = u1%ExternalHSSBrFrac + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%TwrAccel - u2%TwrAccel) + t(2)**2*(-u1%TwrAccel + u3%TwrAccel))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%TwrAccel + t(3)*u2%TwrAccel - t(2)*u3%TwrAccel ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%TwrAccel = u1%TwrAccel + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%YawErr - u2%YawErr) + t(2)**2*(-u1%YawErr + u3%YawErr))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%YawErr + t(3)*u2%YawErr - t(2)*u3%YawErr ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%YawErr = u1%YawErr + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%WindDir - u2%WindDir) + t(2)**2*(-u1%WindDir + u3%WindDir))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%WindDir + t(3)*u2%WindDir - t(2)*u3%WindDir ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%WindDir = u1%WindDir + b0 * t_out + c0 * t_out**2 - ALLOCATE(b1(SIZE(u_out%RootMyc,1))) - ALLOCATE(c1(SIZE(u_out%RootMyc,1))) - b1 = (t(3)**2*(u1%RootMyc - u2%RootMyc) + t(2)**2*(-u1%RootMyc + u3%RootMyc))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%RootMyc + t(3)*u2%RootMyc - t(2)*u3%RootMyc ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%RootMyc = u1%RootMyc + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - b0 = (t(3)**2*(u1%YawBrTAxp - u2%YawBrTAxp) + t(2)**2*(-u1%YawBrTAxp + u3%YawBrTAxp))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%YawBrTAxp + t(3)*u2%YawBrTAxp - t(2)*u3%YawBrTAxp ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%YawBrTAxp = u1%YawBrTAxp + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%YawBrTAyp - u2%YawBrTAyp) + t(2)**2*(-u1%YawBrTAyp + u3%YawBrTAyp))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%YawBrTAyp + t(3)*u2%YawBrTAyp - t(2)*u3%YawBrTAyp ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%YawBrTAyp = u1%YawBrTAyp + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%LSSTipPxa - u2%LSSTipPxa) + t(2)**2*(-u1%LSSTipPxa + u3%LSSTipPxa))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%LSSTipPxa + t(3)*u2%LSSTipPxa - t(2)*u3%LSSTipPxa ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%LSSTipPxa = u1%LSSTipPxa + b0 * t_out + c0 * t_out**2 - ALLOCATE(b1(SIZE(u_out%RootMxc,1))) - ALLOCATE(c1(SIZE(u_out%RootMxc,1))) - b1 = (t(3)**2*(u1%RootMxc - u2%RootMxc) + t(2)**2*(-u1%RootMxc + u3%RootMxc))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%RootMxc + t(3)*u2%RootMxc - t(2)*u3%RootMxc ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%RootMxc = u1%RootMxc + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) - b0 = (t(3)**2*(u1%LSSTipMxa - u2%LSSTipMxa) + t(2)**2*(-u1%LSSTipMxa + u3%LSSTipMxa))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%LSSTipMxa + t(3)*u2%LSSTipMxa - t(2)*u3%LSSTipMxa ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%LSSTipMxa = u1%LSSTipMxa + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%LSSTipMya - u2%LSSTipMya) + t(2)**2*(-u1%LSSTipMya + u3%LSSTipMya))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%LSSTipMya + t(3)*u2%LSSTipMya - t(2)*u3%LSSTipMya ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%LSSTipMya = u1%LSSTipMya + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%LSSTipMza - u2%LSSTipMza) + t(2)**2*(-u1%LSSTipMza + u3%LSSTipMza))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%LSSTipMza + t(3)*u2%LSSTipMza - t(2)*u3%LSSTipMza ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%LSSTipMza = u1%LSSTipMza + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%LSSTipMys - u2%LSSTipMys) + t(2)**2*(-u1%LSSTipMys + u3%LSSTipMys))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%LSSTipMys + t(3)*u2%LSSTipMys - t(2)*u3%LSSTipMys ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%LSSTipMys = u1%LSSTipMys + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%LSSTipMzs - u2%LSSTipMzs) + t(2)**2*(-u1%LSSTipMzs + u3%LSSTipMzs))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%LSSTipMzs + t(3)*u2%LSSTipMzs - t(2)*u3%LSSTipMzs ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%LSSTipMzs = u1%LSSTipMzs + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%YawBrMyn - u2%YawBrMyn) + t(2)**2*(-u1%YawBrMyn + u3%YawBrMyn))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%YawBrMyn + t(3)*u2%YawBrMyn - t(2)*u3%YawBrMyn ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%YawBrMyn = u1%YawBrMyn + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%YawBrMzn - u2%YawBrMzn) + t(2)**2*(-u1%YawBrMzn + u3%YawBrMzn))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%YawBrMzn + t(3)*u2%YawBrMzn - t(2)*u3%YawBrMzn ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%YawBrMzn = u1%YawBrMzn + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%NcIMURAxs - u2%NcIMURAxs) + t(2)**2*(-u1%NcIMURAxs + u3%NcIMURAxs))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%NcIMURAxs + t(3)*u2%NcIMURAxs - t(2)*u3%NcIMURAxs ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%NcIMURAxs = u1%NcIMURAxs + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%NcIMURAys - u2%NcIMURAys) + t(2)**2*(-u1%NcIMURAys + u3%NcIMURAys))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%NcIMURAys + t(3)*u2%NcIMURAys - t(2)*u3%NcIMURAys ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%NcIMURAys = u1%NcIMURAys + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%NcIMURAzs - u2%NcIMURAzs) + t(2)**2*(-u1%NcIMURAzs + u3%NcIMURAzs))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%NcIMURAzs + t(3)*u2%NcIMURAzs - t(2)*u3%NcIMURAzs ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%NcIMURAzs = u1%NcIMURAzs + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%RotPwr - u2%RotPwr) + t(2)**2*(-u1%RotPwr + u3%RotPwr))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%RotPwr + t(3)*u2%RotPwr - t(2)*u3%RotPwr ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%RotPwr = u1%RotPwr + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%HorWindV - u2%HorWindV) + t(2)**2*(-u1%HorWindV + u3%HorWindV))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%HorWindV + t(3)*u2%HorWindV - t(2)*u3%HorWindV ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%HorWindV = u1%HorWindV + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%YawAngle - u2%YawAngle) + t(2)**2*(-u1%YawAngle + u3%YawAngle))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%YawAngle + t(3)*u2%YawAngle - t(2)*u3%YawAngle ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%YawAngle = u1%YawAngle + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%ElecPwr_prev - u2%ElecPwr_prev) + t(2)**2*(-u1%ElecPwr_prev + u3%ElecPwr_prev))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%ElecPwr_prev + t(3)*u2%ElecPwr_prev - t(2)*u3%ElecPwr_prev ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%ElecPwr_prev = u1%ElecPwr_prev + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(u1%GenTrq_prev - u2%GenTrq_prev) + t(2)**2*(-u1%GenTrq_prev + u3%GenTrq_prev))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*u1%GenTrq_prev + t(3)*u2%GenTrq_prev - t(2)*u3%GenTrq_prev ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%GenTrq_prev = u1%GenTrq_prev + b0 * t_out + c0 * t_out**2 + b = (t(3)**2*(u1%ExternalGenTrq - u2%ExternalGenTrq) + t(2)**2*(-u1%ExternalGenTrq + u3%ExternalGenTrq))* scaleFactor + c = ( (t(2)-t(3))*u1%ExternalGenTrq + t(3)*u2%ExternalGenTrq - t(2)*u3%ExternalGenTrq ) * scaleFactor + u_out%ExternalGenTrq = u1%ExternalGenTrq + b + c * t_out + b = (t(3)**2*(u1%ExternalElecPwr - u2%ExternalElecPwr) + t(2)**2*(-u1%ExternalElecPwr + u3%ExternalElecPwr))* scaleFactor + c = ( (t(2)-t(3))*u1%ExternalElecPwr + t(3)*u2%ExternalElecPwr - t(2)*u3%ExternalElecPwr ) * scaleFactor + u_out%ExternalElecPwr = u1%ExternalElecPwr + b + c * t_out + b = (t(3)**2*(u1%ExternalHSSBrFrac - u2%ExternalHSSBrFrac) + t(2)**2*(-u1%ExternalHSSBrFrac + u3%ExternalHSSBrFrac))* scaleFactor + c = ( (t(2)-t(3))*u1%ExternalHSSBrFrac + t(3)*u2%ExternalHSSBrFrac - t(2)*u3%ExternalHSSBrFrac ) * scaleFactor + u_out%ExternalHSSBrFrac = u1%ExternalHSSBrFrac + b + c * t_out + b = (t(3)**2*(u1%TwrAccel - u2%TwrAccel) + t(2)**2*(-u1%TwrAccel + u3%TwrAccel))* scaleFactor + c = ( (t(2)-t(3))*u1%TwrAccel + t(3)*u2%TwrAccel - t(2)*u3%TwrAccel ) * scaleFactor + u_out%TwrAccel = u1%TwrAccel + b + c * t_out + CALL Angles_ExtrapInterp( u1%YawErr, u2%YawErr, u3%YawErr, tin, u_out%YawErr, tin_out ) + CALL Angles_ExtrapInterp( u1%WindDir, u2%WindDir, u3%WindDir, tin, u_out%WindDir, tin_out ) + DO i1 = LBOUND(u_out%RootMyc,1),UBOUND(u_out%RootMyc,1) + b = (t(3)**2*(u1%RootMyc(i1) - u2%RootMyc(i1)) + t(2)**2*(-u1%RootMyc(i1) + u3%RootMyc(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%RootMyc(i1) + t(3)*u2%RootMyc(i1) - t(2)*u3%RootMyc(i1) ) * scaleFactor + u_out%RootMyc(i1) = u1%RootMyc(i1) + b + c * t_out + END DO + b = (t(3)**2*(u1%YawBrTAxp - u2%YawBrTAxp) + t(2)**2*(-u1%YawBrTAxp + u3%YawBrTAxp))* scaleFactor + c = ( (t(2)-t(3))*u1%YawBrTAxp + t(3)*u2%YawBrTAxp - t(2)*u3%YawBrTAxp ) * scaleFactor + u_out%YawBrTAxp = u1%YawBrTAxp + b + c * t_out + b = (t(3)**2*(u1%YawBrTAyp - u2%YawBrTAyp) + t(2)**2*(-u1%YawBrTAyp + u3%YawBrTAyp))* scaleFactor + c = ( (t(2)-t(3))*u1%YawBrTAyp + t(3)*u2%YawBrTAyp - t(2)*u3%YawBrTAyp ) * scaleFactor + u_out%YawBrTAyp = u1%YawBrTAyp + b + c * t_out + b = (t(3)**2*(u1%LSSTipPxa - u2%LSSTipPxa) + t(2)**2*(-u1%LSSTipPxa + u3%LSSTipPxa))* scaleFactor + c = ( (t(2)-t(3))*u1%LSSTipPxa + t(3)*u2%LSSTipPxa - t(2)*u3%LSSTipPxa ) * scaleFactor + u_out%LSSTipPxa = u1%LSSTipPxa + b + c * t_out + DO i1 = LBOUND(u_out%RootMxc,1),UBOUND(u_out%RootMxc,1) + b = (t(3)**2*(u1%RootMxc(i1) - u2%RootMxc(i1)) + t(2)**2*(-u1%RootMxc(i1) + u3%RootMxc(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%RootMxc(i1) + t(3)*u2%RootMxc(i1) - t(2)*u3%RootMxc(i1) ) * scaleFactor + u_out%RootMxc(i1) = u1%RootMxc(i1) + b + c * t_out + END DO + b = (t(3)**2*(u1%LSSTipMxa - u2%LSSTipMxa) + t(2)**2*(-u1%LSSTipMxa + u3%LSSTipMxa))* scaleFactor + c = ( (t(2)-t(3))*u1%LSSTipMxa + t(3)*u2%LSSTipMxa - t(2)*u3%LSSTipMxa ) * scaleFactor + u_out%LSSTipMxa = u1%LSSTipMxa + b + c * t_out + b = (t(3)**2*(u1%LSSTipMya - u2%LSSTipMya) + t(2)**2*(-u1%LSSTipMya + u3%LSSTipMya))* scaleFactor + c = ( (t(2)-t(3))*u1%LSSTipMya + t(3)*u2%LSSTipMya - t(2)*u3%LSSTipMya ) * scaleFactor + u_out%LSSTipMya = u1%LSSTipMya + b + c * t_out + b = (t(3)**2*(u1%LSSTipMza - u2%LSSTipMza) + t(2)**2*(-u1%LSSTipMza + u3%LSSTipMza))* scaleFactor + c = ( (t(2)-t(3))*u1%LSSTipMza + t(3)*u2%LSSTipMza - t(2)*u3%LSSTipMza ) * scaleFactor + u_out%LSSTipMza = u1%LSSTipMza + b + c * t_out + b = (t(3)**2*(u1%LSSTipMys - u2%LSSTipMys) + t(2)**2*(-u1%LSSTipMys + u3%LSSTipMys))* scaleFactor + c = ( (t(2)-t(3))*u1%LSSTipMys + t(3)*u2%LSSTipMys - t(2)*u3%LSSTipMys ) * scaleFactor + u_out%LSSTipMys = u1%LSSTipMys + b + c * t_out + b = (t(3)**2*(u1%LSSTipMzs - u2%LSSTipMzs) + t(2)**2*(-u1%LSSTipMzs + u3%LSSTipMzs))* scaleFactor + c = ( (t(2)-t(3))*u1%LSSTipMzs + t(3)*u2%LSSTipMzs - t(2)*u3%LSSTipMzs ) * scaleFactor + u_out%LSSTipMzs = u1%LSSTipMzs + b + c * t_out + b = (t(3)**2*(u1%YawBrMyn - u2%YawBrMyn) + t(2)**2*(-u1%YawBrMyn + u3%YawBrMyn))* scaleFactor + c = ( (t(2)-t(3))*u1%YawBrMyn + t(3)*u2%YawBrMyn - t(2)*u3%YawBrMyn ) * scaleFactor + u_out%YawBrMyn = u1%YawBrMyn + b + c * t_out + b = (t(3)**2*(u1%YawBrMzn - u2%YawBrMzn) + t(2)**2*(-u1%YawBrMzn + u3%YawBrMzn))* scaleFactor + c = ( (t(2)-t(3))*u1%YawBrMzn + t(3)*u2%YawBrMzn - t(2)*u3%YawBrMzn ) * scaleFactor + u_out%YawBrMzn = u1%YawBrMzn + b + c * t_out + b = (t(3)**2*(u1%NcIMURAxs - u2%NcIMURAxs) + t(2)**2*(-u1%NcIMURAxs + u3%NcIMURAxs))* scaleFactor + c = ( (t(2)-t(3))*u1%NcIMURAxs + t(3)*u2%NcIMURAxs - t(2)*u3%NcIMURAxs ) * scaleFactor + u_out%NcIMURAxs = u1%NcIMURAxs + b + c * t_out + b = (t(3)**2*(u1%NcIMURAys - u2%NcIMURAys) + t(2)**2*(-u1%NcIMURAys + u3%NcIMURAys))* scaleFactor + c = ( (t(2)-t(3))*u1%NcIMURAys + t(3)*u2%NcIMURAys - t(2)*u3%NcIMURAys ) * scaleFactor + u_out%NcIMURAys = u1%NcIMURAys + b + c * t_out + b = (t(3)**2*(u1%NcIMURAzs - u2%NcIMURAzs) + t(2)**2*(-u1%NcIMURAzs + u3%NcIMURAzs))* scaleFactor + c = ( (t(2)-t(3))*u1%NcIMURAzs + t(3)*u2%NcIMURAzs - t(2)*u3%NcIMURAzs ) * scaleFactor + u_out%NcIMURAzs = u1%NcIMURAzs + b + c * t_out + b = (t(3)**2*(u1%RotPwr - u2%RotPwr) + t(2)**2*(-u1%RotPwr + u3%RotPwr))* scaleFactor + c = ( (t(2)-t(3))*u1%RotPwr + t(3)*u2%RotPwr - t(2)*u3%RotPwr ) * scaleFactor + u_out%RotPwr = u1%RotPwr + b + c * t_out + b = (t(3)**2*(u1%HorWindV - u2%HorWindV) + t(2)**2*(-u1%HorWindV + u3%HorWindV))* scaleFactor + c = ( (t(2)-t(3))*u1%HorWindV + t(3)*u2%HorWindV - t(2)*u3%HorWindV ) * scaleFactor + u_out%HorWindV = u1%HorWindV + b + c * t_out + CALL Angles_ExtrapInterp( u1%YawAngle, u2%YawAngle, u3%YawAngle, tin, u_out%YawAngle, tin_out ) CALL TMD_Input_ExtrapInterp2( u1%NTMD, u2%NTMD, u3%NTMD, tin, u_out%NTMD, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL TMD_Input_ExtrapInterp2( u1%TTMD, u2%TTMD, u3%TTMD, tin, u_out%TTMD, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(u_out%SuperController) .AND. ALLOCATED(u1%SuperController)) THEN - ALLOCATE(b1(SIZE(u_out%SuperController,1))) - ALLOCATE(c1(SIZE(u_out%SuperController,1))) - b1 = (t(3)**2*(u1%SuperController - u2%SuperController) + t(2)**2*(-u1%SuperController + u3%SuperController))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%SuperController + t(3)*u2%SuperController - t(2)*u3%SuperController ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%SuperController = u1%SuperController + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%SuperController,1),UBOUND(u_out%SuperController,1) + b = (t(3)**2*(u1%SuperController(i1) - u2%SuperController(i1)) + t(2)**2*(-u1%SuperController(i1) + u3%SuperController(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%SuperController(i1) + t(3)*u2%SuperController(i1) - t(2)*u3%SuperController(i1) ) * scaleFactor + u_out%SuperController(i1) = u1%SuperController(i1) + b + c * t_out + END DO END IF ! check if allocated END SUBROUTINE SrvD_Input_ExtrapInterp2 @@ -7669,12 +7997,12 @@ SUBROUTINE SrvD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -7687,57 +8015,48 @@ SUBROUTINE SrvD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMs CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = -(y1%WriteOutput - y2%WriteOutput)/t(2) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO END IF ! check if allocated IF (ALLOCATED(y_out%BlPitchCom) .AND. ALLOCATED(y1%BlPitchCom)) THEN - ALLOCATE(b1(SIZE(y_out%BlPitchCom,1))) - ALLOCATE(c1(SIZE(y_out%BlPitchCom,1))) - b1 = -(y1%BlPitchCom - y2%BlPitchCom)/t(2) - y_out%BlPitchCom = y1%BlPitchCom + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%BlPitchCom,1),UBOUND(y_out%BlPitchCom,1) + CALL Angles_ExtrapInterp( y1%BlPitchCom(i1), y2%BlPitchCom(i1), tin, y_out%BlPitchCom(i1), tin_out ) + END DO END IF ! check if allocated IF (ALLOCATED(y_out%BlAirfoilCom) .AND. ALLOCATED(y1%BlAirfoilCom)) THEN - ALLOCATE(b1(SIZE(y_out%BlAirfoilCom,1))) - ALLOCATE(c1(SIZE(y_out%BlAirfoilCom,1))) - b1 = -(y1%BlAirfoilCom - y2%BlAirfoilCom)/t(2) - y_out%BlAirfoilCom = y1%BlAirfoilCom + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%BlAirfoilCom,1),UBOUND(y_out%BlAirfoilCom,1) + b = -(y1%BlAirfoilCom(i1) - y2%BlAirfoilCom(i1)) + y_out%BlAirfoilCom(i1) = y1%BlAirfoilCom(i1) + b * ScaleFactor + END DO END IF ! check if allocated - b0 = -(y1%YawMom - y2%YawMom)/t(2) - y_out%YawMom = y1%YawMom + b0 * t_out - b0 = -(y1%GenTrq - y2%GenTrq)/t(2) - y_out%GenTrq = y1%GenTrq + b0 * t_out - b0 = -(y1%HSSBrTrqC - y2%HSSBrTrqC)/t(2) - y_out%HSSBrTrqC = y1%HSSBrTrqC + b0 * t_out - b0 = -(y1%ElecPwr - y2%ElecPwr)/t(2) - y_out%ElecPwr = y1%ElecPwr + b0 * t_out + b = -(y1%YawMom - y2%YawMom) + y_out%YawMom = y1%YawMom + b * ScaleFactor + b = -(y1%GenTrq - y2%GenTrq) + y_out%GenTrq = y1%GenTrq + b * ScaleFactor + b = -(y1%HSSBrTrqC - y2%HSSBrTrqC) + y_out%HSSBrTrqC = y1%HSSBrTrqC + b * ScaleFactor + b = -(y1%ElecPwr - y2%ElecPwr) + y_out%ElecPwr = y1%ElecPwr + b * ScaleFactor IF (ALLOCATED(y_out%TBDrCon) .AND. ALLOCATED(y1%TBDrCon)) THEN - ALLOCATE(b1(SIZE(y_out%TBDrCon,1))) - ALLOCATE(c1(SIZE(y_out%TBDrCon,1))) - b1 = -(y1%TBDrCon - y2%TBDrCon)/t(2) - y_out%TBDrCon = y1%TBDrCon + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%TBDrCon,1),UBOUND(y_out%TBDrCon,1) + b = -(y1%TBDrCon(i1) - y2%TBDrCon(i1)) + y_out%TBDrCon(i1) = y1%TBDrCon(i1) + b * ScaleFactor + END DO END IF ! check if allocated CALL TMD_Output_ExtrapInterp1( y1%NTMD, y2%NTMD, tin, y_out%NTMD, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL TMD_Output_ExtrapInterp1( y1%TTMD, y2%TTMD, tin, y_out%TTMD, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%SuperController) .AND. ALLOCATED(y1%SuperController)) THEN - ALLOCATE(b1(SIZE(y_out%SuperController,1))) - ALLOCATE(c1(SIZE(y_out%SuperController,1))) - b1 = -(y1%SuperController - y2%SuperController)/t(2) - y_out%SuperController = y1%SuperController + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%SuperController,1),UBOUND(y_out%SuperController,1) + b = -(y1%SuperController(i1) - y2%SuperController(i1)) + y_out%SuperController(i1) = y1%SuperController(i1) + b * ScaleFactor + END DO END IF ! check if allocated END SUBROUTINE SrvD_Output_ExtrapInterp1 @@ -7768,13 +8087,14 @@ SUBROUTINE SrvD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'SrvD_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -7793,66 +8113,56 @@ SUBROUTINE SrvD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, E CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = (t(3)**2*(y1%WriteOutput - y2%WriteOutput) + t(2)**2*(-y1%WriteOutput + y3%WriteOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WriteOutput + t(3)*y2%WriteOutput - t(2)*y3%WriteOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO END IF ! check if allocated IF (ALLOCATED(y_out%BlPitchCom) .AND. ALLOCATED(y1%BlPitchCom)) THEN - ALLOCATE(b1(SIZE(y_out%BlPitchCom,1))) - ALLOCATE(c1(SIZE(y_out%BlPitchCom,1))) - b1 = (t(3)**2*(y1%BlPitchCom - y2%BlPitchCom) + t(2)**2*(-y1%BlPitchCom + y3%BlPitchCom))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%BlPitchCom + t(3)*y2%BlPitchCom - t(2)*y3%BlPitchCom ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%BlPitchCom = y1%BlPitchCom + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%BlPitchCom,1),UBOUND(y_out%BlPitchCom,1) + CALL Angles_ExtrapInterp( y1%BlPitchCom(i1), y2%BlPitchCom(i1), y3%BlPitchCom(i1), tin, y_out%BlPitchCom(i1), tin_out ) + END DO END IF ! check if allocated IF (ALLOCATED(y_out%BlAirfoilCom) .AND. ALLOCATED(y1%BlAirfoilCom)) THEN - ALLOCATE(b1(SIZE(y_out%BlAirfoilCom,1))) - ALLOCATE(c1(SIZE(y_out%BlAirfoilCom,1))) - b1 = (t(3)**2*(y1%BlAirfoilCom - y2%BlAirfoilCom) + t(2)**2*(-y1%BlAirfoilCom + y3%BlAirfoilCom))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%BlAirfoilCom + t(3)*y2%BlAirfoilCom - t(2)*y3%BlAirfoilCom ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%BlAirfoilCom = y1%BlAirfoilCom + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%BlAirfoilCom,1),UBOUND(y_out%BlAirfoilCom,1) + b = (t(3)**2*(y1%BlAirfoilCom(i1) - y2%BlAirfoilCom(i1)) + t(2)**2*(-y1%BlAirfoilCom(i1) + y3%BlAirfoilCom(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%BlAirfoilCom(i1) + t(3)*y2%BlAirfoilCom(i1) - t(2)*y3%BlAirfoilCom(i1) ) * scaleFactor + y_out%BlAirfoilCom(i1) = y1%BlAirfoilCom(i1) + b + c * t_out + END DO END IF ! check if allocated - b0 = (t(3)**2*(y1%YawMom - y2%YawMom) + t(2)**2*(-y1%YawMom + y3%YawMom))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%YawMom + t(3)*y2%YawMom - t(2)*y3%YawMom ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%YawMom = y1%YawMom + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%GenTrq - y2%GenTrq) + t(2)**2*(-y1%GenTrq + y3%GenTrq))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%GenTrq + t(3)*y2%GenTrq - t(2)*y3%GenTrq ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%GenTrq = y1%GenTrq + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%HSSBrTrqC - y2%HSSBrTrqC) + t(2)**2*(-y1%HSSBrTrqC + y3%HSSBrTrqC))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%HSSBrTrqC + t(3)*y2%HSSBrTrqC - t(2)*y3%HSSBrTrqC ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%HSSBrTrqC = y1%HSSBrTrqC + b0 * t_out + c0 * t_out**2 - b0 = (t(3)**2*(y1%ElecPwr - y2%ElecPwr) + t(2)**2*(-y1%ElecPwr + y3%ElecPwr))/(t(2)*t(3)*(t(2) - t(3))) - c0 = ( (t(2)-t(3))*y1%ElecPwr + t(3)*y2%ElecPwr - t(2)*y3%ElecPwr ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%ElecPwr = y1%ElecPwr + b0 * t_out + c0 * t_out**2 + b = (t(3)**2*(y1%YawMom - y2%YawMom) + t(2)**2*(-y1%YawMom + y3%YawMom))* scaleFactor + c = ( (t(2)-t(3))*y1%YawMom + t(3)*y2%YawMom - t(2)*y3%YawMom ) * scaleFactor + y_out%YawMom = y1%YawMom + b + c * t_out + b = (t(3)**2*(y1%GenTrq - y2%GenTrq) + t(2)**2*(-y1%GenTrq + y3%GenTrq))* scaleFactor + c = ( (t(2)-t(3))*y1%GenTrq + t(3)*y2%GenTrq - t(2)*y3%GenTrq ) * scaleFactor + y_out%GenTrq = y1%GenTrq + b + c * t_out + b = (t(3)**2*(y1%HSSBrTrqC - y2%HSSBrTrqC) + t(2)**2*(-y1%HSSBrTrqC + y3%HSSBrTrqC))* scaleFactor + c = ( (t(2)-t(3))*y1%HSSBrTrqC + t(3)*y2%HSSBrTrqC - t(2)*y3%HSSBrTrqC ) * scaleFactor + y_out%HSSBrTrqC = y1%HSSBrTrqC + b + c * t_out + b = (t(3)**2*(y1%ElecPwr - y2%ElecPwr) + t(2)**2*(-y1%ElecPwr + y3%ElecPwr))* scaleFactor + c = ( (t(2)-t(3))*y1%ElecPwr + t(3)*y2%ElecPwr - t(2)*y3%ElecPwr ) * scaleFactor + y_out%ElecPwr = y1%ElecPwr + b + c * t_out IF (ALLOCATED(y_out%TBDrCon) .AND. ALLOCATED(y1%TBDrCon)) THEN - ALLOCATE(b1(SIZE(y_out%TBDrCon,1))) - ALLOCATE(c1(SIZE(y_out%TBDrCon,1))) - b1 = (t(3)**2*(y1%TBDrCon - y2%TBDrCon) + t(2)**2*(-y1%TBDrCon + y3%TBDrCon))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%TBDrCon + t(3)*y2%TBDrCon - t(2)*y3%TBDrCon ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%TBDrCon = y1%TBDrCon + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%TBDrCon,1),UBOUND(y_out%TBDrCon,1) + b = (t(3)**2*(y1%TBDrCon(i1) - y2%TBDrCon(i1)) + t(2)**2*(-y1%TBDrCon(i1) + y3%TBDrCon(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%TBDrCon(i1) + t(3)*y2%TBDrCon(i1) - t(2)*y3%TBDrCon(i1) ) * scaleFactor + y_out%TBDrCon(i1) = y1%TBDrCon(i1) + b + c * t_out + END DO END IF ! check if allocated CALL TMD_Output_ExtrapInterp2( y1%NTMD, y2%NTMD, y3%NTMD, tin, y_out%NTMD, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL TMD_Output_ExtrapInterp2( y1%TTMD, y2%TTMD, y3%TTMD, tin, y_out%TTMD, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%SuperController) .AND. ALLOCATED(y1%SuperController)) THEN - ALLOCATE(b1(SIZE(y_out%SuperController,1))) - ALLOCATE(c1(SIZE(y_out%SuperController,1))) - b1 = (t(3)**2*(y1%SuperController - y2%SuperController) + t(2)**2*(-y1%SuperController + y3%SuperController))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%SuperController + t(3)*y2%SuperController - t(2)*y3%SuperController ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%SuperController = y1%SuperController + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%SuperController,1),UBOUND(y_out%SuperController,1) + b = (t(3)**2*(y1%SuperController(i1) - y2%SuperController(i1)) + t(2)**2*(-y1%SuperController(i1) + y3%SuperController(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%SuperController(i1) + t(3)*y2%SuperController(i1) - t(2)*y3%SuperController(i1) ) * scaleFactor + y_out%SuperController(i1) = y1%SuperController(i1) + b + c * t_out + END DO END IF ! check if allocated END SUBROUTINE SrvD_Output_ExtrapInterp2 diff --git a/modules/servodyn/src/TMD.f90 b/modules/servodyn/src/TMD.f90 index bce0a770e6..df29a5426d 100644 --- a/modules/servodyn/src/TMD.f90 +++ b/modules/servodyn/src/TMD.f90 @@ -442,7 +442,7 @@ END SUBROUTINE TMD_UpdateStates !! !! For details, see: !! Press, W. H.; Flannery, B. P.; Teukolsky, S. A.; and Vetterling, W. T. "Runge-Kutta Method" and "Adaptive Step Size Control for -!! Runge-Kutta." �16.1 and 16.2 in Numerical Recipes in FORTRAN: The Art of Scientific Computing, 2nd ed. Cambridge, England: +!! Runge-Kutta." Sections 16.1 and 16.2 in Numerical Recipes in FORTRAN: The Art of Scientific Computing, 2nd ed. Cambridge, England: !! Cambridge University Press, pp. 704-716, 1992. SUBROUTINE TMD_RK4( t, n, u, utimes, p, x, xd, z, OtherState, m, ErrStat, ErrMsg ) !.................................................................................................................................. diff --git a/modules/servodyn/src/TMD_Registry.txt b/modules/servodyn/src/TMD_Registry.txt index 105c5a0e95..c2d74036c8 100644 --- a/modules/servodyn/src/TMD_Registry.txt +++ b/modules/servodyn/src/TMD_Registry.txt @@ -53,8 +53,8 @@ typedef ^ ^ ReKi Gravity - - - "Gravitational acceleration" m/s^2 typedef ^ ^ ReKi r_N_O_G {3} - - "nacelle origin for setting up mesh" - # Define outputs from the initialization routine here: typedef ^ InitOutputType SiKi DummyInitOut - - - "dummy init output" - -#typedef ^ InitOutputType CHARACTER(10) WriteOutputHdr {:} - - "Names of the output-to-file channels" - -#typedef ^ InitOutputType CHARACTER(10) WriteOutputUnt {:}- - "Units of the output-to-file channels" - +#typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputHdr {:} - - "Names of the output-to-file channels" - +#typedef ^ InitOutputType CHARACTER(ChanLen) WriteOutputUnt {:}- - "Units of the output-to-file channels" - # ..... States .................................................................................................................... # Define continuous (differentiable) states here: diff --git a/modules/servodyn/src/TMD_Types.f90 b/modules/servodyn/src/TMD_Types.f90 index a76b12542c..c0ba34ab4c 100644 --- a/modules/servodyn/src/TMD_Types.f90 +++ b/modules/servodyn/src/TMD_Types.f90 @@ -344,78 +344,78 @@ SUBROUTINE TMD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%TMDFileName) - IntKiBuf(Int_Xferred) = ICHAR(InData%TMDFileName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TMD_CMODE - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TMD_SA_MODE - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TMD_DOF_MODE - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TMD_X_DOF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TMD_Y_DOF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_X_DSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_Y_DSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_X_M - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_Y_M - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_XY_M - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_X_K - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_Y_K - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_X_C - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_Y_C - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_X_DWSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_X_UWSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_X_KS - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_X_CS - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_Y_PLSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_Y_NLSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_Y_KS - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_Y_CS - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_P_X - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_P_Y - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_P_Z - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_X_C_HIGH - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_X_C_LOW - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_Y_C_HIGH - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_Y_C_LOW - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_X_C_BRAKE - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_Y_C_BRAKE - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%USE_F_TBL , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%TMD_F_TBL_FILE) - IntKiBuf(Int_Xferred) = ICHAR(InData%TMD_F_TBL_FILE(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(InData%TMDFileName) + IntKiBuf(Int_Xferred) = ICHAR(InData%TMDFileName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%TMD_CMODE + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TMD_SA_MODE + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TMD_DOF_MODE + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TMD_X_DOF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TMD_Y_DOF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_X_DSP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_Y_DSP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_X_M + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_Y_M + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_XY_M + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_X_K + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_Y_K + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_X_C + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_Y_C + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_X_DWSP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_X_UWSP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_X_KS + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_X_CS + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_Y_PLSP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_Y_NLSP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_Y_KS + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_Y_CS + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_P_X + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_P_Y + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_P_Z + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_X_C_HIGH + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_X_C_LOW + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_Y_C_HIGH + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_Y_C_LOW + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_X_C_BRAKE + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_Y_C_BRAKE + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%USE_F_TBL, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%TMD_F_TBL_FILE) + IntKiBuf(Int_Xferred) = ICHAR(InData%TMD_F_TBL_FILE(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( .NOT. ALLOCATED(InData%F_TBL) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -429,8 +429,12 @@ SUBROUTINE TMD_PackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_TBL,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%F_TBL)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F_TBL))-1 ) = PACK(InData%F_TBL,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F_TBL) + DO i2 = LBOUND(InData%F_TBL,2), UBOUND(InData%F_TBL,2) + DO i1 = LBOUND(InData%F_TBL,1), UBOUND(InData%F_TBL,1) + ReKiBuf(Re_Xferred) = InData%F_TBL(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE TMD_PackInputFile @@ -447,12 +451,6 @@ SUBROUTINE TMD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -468,78 +466,78 @@ SUBROUTINE TMD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%TMDFileName) - OutData%TMDFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%TMD_CMODE = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TMD_SA_MODE = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TMD_DOF_MODE = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TMD_X_DOF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%TMD_Y_DOF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%TMD_X_DSP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_Y_DSP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_X_M = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_Y_M = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_XY_M = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_X_K = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_Y_K = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_X_C = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_Y_C = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_X_DWSP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_X_UWSP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_X_KS = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_X_CS = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_Y_PLSP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_Y_NLSP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_Y_KS = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_Y_CS = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_P_X = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_P_Y = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_P_Z = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_X_C_HIGH = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_X_C_LOW = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_Y_C_HIGH = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_Y_C_LOW = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_X_C_BRAKE = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_Y_C_BRAKE = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%USE_F_TBL = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%TMD_F_TBL_FILE) - OutData%TMD_F_TBL_FILE(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%TMDFileName) + OutData%TMDFileName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%TMD_CMODE = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TMD_SA_MODE = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TMD_DOF_MODE = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TMD_X_DOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%TMD_X_DOF) + Int_Xferred = Int_Xferred + 1 + OutData%TMD_Y_DOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%TMD_Y_DOF) + Int_Xferred = Int_Xferred + 1 + OutData%TMD_X_DSP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_Y_DSP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_X_M = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_Y_M = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_XY_M = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_X_K = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_Y_K = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_X_C = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_Y_C = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_X_DWSP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_X_UWSP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_X_KS = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_X_CS = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_Y_PLSP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_Y_NLSP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_Y_KS = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_Y_CS = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_P_X = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_P_Y = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_P_Z = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_X_C_HIGH = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_X_C_LOW = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_Y_C_HIGH = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_Y_C_LOW = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_X_C_BRAKE = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_Y_C_BRAKE = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%USE_F_TBL = TRANSFER(IntKiBuf(Int_Xferred), OutData%USE_F_TBL) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%TMD_F_TBL_FILE) + OutData%TMD_F_TBL_FILE(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_TBL not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -556,15 +554,12 @@ SUBROUTINE TMD_UnPackInputFile( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_TBL.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%F_TBL)>0) OutData%F_TBL = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F_TBL))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F_TBL) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%F_TBL,2), UBOUND(OutData%F_TBL,2) + DO i1 = LBOUND(OutData%F_TBL,1), UBOUND(OutData%F_TBL,1) + OutData%F_TBL(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE TMD_UnPackInputFile @@ -666,18 +661,20 @@ SUBROUTINE TMD_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%InputFile) - IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%r_N_O_G))-1 ) = PACK(InData%r_N_O_G,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%r_N_O_G) + DO I = 1, LEN(InData%InputFile) + IntKiBuf(Int_Xferred) = ICHAR(InData%InputFile(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + ReKiBuf(Re_Xferred) = InData%Gravity + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%r_N_O_G,1), UBOUND(InData%r_N_O_G,1) + ReKiBuf(Re_Xferred) = InData%r_N_O_G(i1) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE TMD_PackInitInput SUBROUTINE TMD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -693,12 +690,6 @@ SUBROUTINE TMD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -713,27 +704,22 @@ SUBROUTINE TMD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%InputFile) - OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%Gravity = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO I = 1, LEN(OutData%InputFile) + OutData%InputFile(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%Gravity = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%r_N_O_G,1) i1_u = UBOUND(OutData%r_N_O_G,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%r_N_O_G = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%r_N_O_G))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%r_N_O_G) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%r_N_O_G,1), UBOUND(OutData%r_N_O_G,1) + OutData%r_N_O_G(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE TMD_UnPackInitInput SUBROUTINE TMD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -827,8 +813,8 @@ SUBROUTINE TMD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyInitOut - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyInitOut + Re_Xferred = Re_Xferred + 1 END SUBROUTINE TMD_PackInitOutput SUBROUTINE TMD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -844,12 +830,6 @@ SUBROUTINE TMD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'TMD_UnPackInitOutput' @@ -863,8 +843,8 @@ SUBROUTINE TMD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyInitOut = REAL( ReKiBuf( Re_Xferred ), SiKi) - Re_Xferred = Re_Xferred + 1 + OutData%DummyInitOut = REAL(ReKiBuf(Re_Xferred), SiKi) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE TMD_UnPackInitOutput SUBROUTINE TMD_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) @@ -961,10 +941,12 @@ SUBROUTINE TMD_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyContState - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%tmd_x))-1 ) = PACK(InData%tmd_x,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%tmd_x) + ReKiBuf(Re_Xferred) = InData%DummyContState + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%tmd_x,1), UBOUND(InData%tmd_x,1) + ReKiBuf(Re_Xferred) = InData%tmd_x(i1) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE TMD_PackContState SUBROUTINE TMD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -980,12 +962,6 @@ SUBROUTINE TMD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1000,19 +976,14 @@ SUBROUTINE TMD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyContState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyContState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%tmd_x,1) i1_u = UBOUND(OutData%tmd_x,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%tmd_x = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%tmd_x))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%tmd_x) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%tmd_x,1), UBOUND(OutData%tmd_x,1) + OutData%tmd_x(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END SUBROUTINE TMD_UnPackContState SUBROUTINE TMD_CopyDiscState( SrcDiscStateData, DstDiscStateData, CtrlCode, ErrStat, ErrMsg ) @@ -1106,8 +1077,8 @@ SUBROUTINE TMD_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyDiscState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyDiscState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE TMD_PackDiscState SUBROUTINE TMD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1123,12 +1094,6 @@ SUBROUTINE TMD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'TMD_UnPackDiscState' @@ -1142,8 +1107,8 @@ SUBROUTINE TMD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyDiscState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyDiscState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE TMD_UnPackDiscState SUBROUTINE TMD_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) @@ -1237,8 +1202,8 @@ SUBROUTINE TMD_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyConstrState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE TMD_PackConstrState SUBROUTINE TMD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1254,12 +1219,6 @@ SUBROUTINE TMD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'TMD_UnPackConstrState' @@ -1273,8 +1232,8 @@ SUBROUTINE TMD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyConstrState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyConstrState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE TMD_UnPackConstrState SUBROUTINE TMD_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -1368,8 +1327,8 @@ SUBROUTINE TMD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyOtherState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyOtherState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE TMD_PackOtherState SUBROUTINE TMD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1385,12 +1344,6 @@ SUBROUTINE TMD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'TMD_UnPackOtherState' @@ -1404,8 +1357,8 @@ SUBROUTINE TMD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyOtherState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyOtherState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE TMD_UnPackOtherState SUBROUTINE TMD_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) @@ -1514,22 +1467,34 @@ SUBROUTINE TMD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F_stop))-1 ) = PACK(InData%F_stop,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F_stop) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F_ext))-1 ) = PACK(InData%F_ext,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F_ext) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F_fr))-1 ) = PACK(InData%F_fr,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F_fr) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%C_ctrl))-1 ) = PACK(InData%C_ctrl,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%C_ctrl) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%C_Brake))-1 ) = PACK(InData%C_Brake,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%C_Brake) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F_table))-1 ) = PACK(InData%F_table,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F_table) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%F_k_x - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%F_k_y - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%F_stop,1), UBOUND(InData%F_stop,1) + ReKiBuf(Re_Xferred) = InData%F_stop(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%F_ext,1), UBOUND(InData%F_ext,1) + ReKiBuf(Re_Xferred) = InData%F_ext(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%F_fr,1), UBOUND(InData%F_fr,1) + ReKiBuf(Re_Xferred) = InData%F_fr(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%C_ctrl,1), UBOUND(InData%C_ctrl,1) + ReKiBuf(Re_Xferred) = InData%C_ctrl(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%C_Brake,1), UBOUND(InData%C_Brake,1) + ReKiBuf(Re_Xferred) = InData%C_Brake(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%F_table,1), UBOUND(InData%F_table,1) + ReKiBuf(Re_Xferred) = InData%F_table(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%F_k_x + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%F_k_y + Re_Xferred = Re_Xferred + 1 END SUBROUTINE TMD_PackMisc SUBROUTINE TMD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1545,12 +1510,6 @@ SUBROUTINE TMD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1567,74 +1526,44 @@ SUBROUTINE TMD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Int_Xferred = 1 i1_l = LBOUND(OutData%F_stop,1) i1_u = UBOUND(OutData%F_stop,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%F_stop = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F_stop))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F_stop) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%F_stop,1), UBOUND(OutData%F_stop,1) + OutData%F_stop(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%F_ext,1) i1_u = UBOUND(OutData%F_ext,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%F_ext = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F_ext))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F_ext) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%F_ext,1), UBOUND(OutData%F_ext,1) + OutData%F_ext(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%F_fr,1) i1_u = UBOUND(OutData%F_fr,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%F_fr = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F_fr))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F_fr) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%F_fr,1), UBOUND(OutData%F_fr,1) + OutData%F_fr(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%C_ctrl,1) i1_u = UBOUND(OutData%C_ctrl,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%C_ctrl = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%C_ctrl))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%C_ctrl) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%C_ctrl,1), UBOUND(OutData%C_ctrl,1) + OutData%C_ctrl(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%C_Brake,1) i1_u = UBOUND(OutData%C_Brake,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%C_Brake = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%C_Brake))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%C_Brake) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%C_Brake,1), UBOUND(OutData%C_Brake,1) + OutData%C_Brake(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%F_table,1) i1_u = UBOUND(OutData%F_table,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%F_table = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F_table))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F_table) - DEALLOCATE(mask1) - OutData%F_k_x = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%F_k_y = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(OutData%F_table,1), UBOUND(OutData%F_table,1) + OutData%F_table(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%F_k_x = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%F_k_y = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE TMD_UnPackMisc SUBROUTINE TMD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -1808,66 +1737,76 @@ SUBROUTINE TMD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TMD_DOF_MODE - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TMD_X_DOF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TMD_Y_DOF , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%X_DSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Y_DSP - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%M_X - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%M_Y - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%M_XY - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%K_X - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%K_Y - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%C_X - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%C_Y - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%K_S))-1 ) = PACK(InData%K_S,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%K_S) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%C_S))-1 ) = PACK(InData%C_S,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%C_S) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%P_SP))-1 ) = PACK(InData%P_SP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%P_SP) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%N_SP))-1 ) = PACK(InData%N_SP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%N_SP) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F_ext))-1 ) = PACK(InData%F_ext,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F_ext) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Gravity - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TMD_CMODE - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TMD_SA_MODE - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_X_C_HIGH - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_X_C_LOW - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_Y_C_HIGH - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_Y_C_LOW - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_X_C_BRAKE - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%TMD_Y_C_BRAKE - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Use_F_TBL , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + IntKiBuf(Int_Xferred) = InData%TMD_DOF_MODE + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TMD_X_DOF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TMD_Y_DOF, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%X_DSP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Y_DSP + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%M_X + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%M_Y + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%M_XY + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%K_X + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%K_Y + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%C_X + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%C_Y + Re_Xferred = Re_Xferred + 1 + DO i1 = LBOUND(InData%K_S,1), UBOUND(InData%K_S,1) + ReKiBuf(Re_Xferred) = InData%K_S(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%C_S,1), UBOUND(InData%C_S,1) + ReKiBuf(Re_Xferred) = InData%C_S(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%P_SP,1), UBOUND(InData%P_SP,1) + ReKiBuf(Re_Xferred) = InData%P_SP(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%N_SP,1), UBOUND(InData%N_SP,1) + ReKiBuf(Re_Xferred) = InData%N_SP(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%F_ext,1), UBOUND(InData%F_ext,1) + ReKiBuf(Re_Xferred) = InData%F_ext(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%Gravity + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TMD_CMODE + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TMD_SA_MODE + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_X_C_HIGH + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_X_C_LOW + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_Y_C_HIGH + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_Y_C_LOW + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_X_C_BRAKE + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%TMD_Y_C_BRAKE + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%Use_F_TBL, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%F_TBL) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1881,8 +1820,12 @@ SUBROUTINE TMD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F_TBL,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%F_TBL)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F_TBL))-1 ) = PACK(InData%F_TBL,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F_TBL) + DO i2 = LBOUND(InData%F_TBL,2), UBOUND(InData%F_TBL,2) + DO i1 = LBOUND(InData%F_TBL,1), UBOUND(InData%F_TBL,1) + ReKiBuf(Re_Xferred) = InData%F_TBL(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE TMD_PackParam @@ -1899,12 +1842,6 @@ SUBROUTINE TMD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -1920,111 +1857,86 @@ SUBROUTINE TMD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - OutData%TMD_DOF_MODE = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TMD_X_DOF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%TMD_Y_DOF = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%X_DSP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Y_DSP = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%M_X = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%M_Y = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%M_XY = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%K_X = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%K_Y = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%C_X = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%C_Y = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + OutData%TMD_DOF_MODE = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TMD_X_DOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%TMD_X_DOF) + Int_Xferred = Int_Xferred + 1 + OutData%TMD_Y_DOF = TRANSFER(IntKiBuf(Int_Xferred), OutData%TMD_Y_DOF) + Int_Xferred = Int_Xferred + 1 + OutData%X_DSP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Y_DSP = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%M_X = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%M_Y = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%M_XY = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%K_X = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%K_Y = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%C_X = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%C_Y = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 i1_l = LBOUND(OutData%K_S,1) i1_u = UBOUND(OutData%K_S,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%K_S = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%K_S))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%K_S) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%K_S,1), UBOUND(OutData%K_S,1) + OutData%K_S(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%C_S,1) i1_u = UBOUND(OutData%C_S,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%C_S = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%C_S))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%C_S) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%C_S,1), UBOUND(OutData%C_S,1) + OutData%C_S(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%P_SP,1) i1_u = UBOUND(OutData%P_SP,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%P_SP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%P_SP))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%P_SP) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%P_SP,1), UBOUND(OutData%P_SP,1) + OutData%P_SP(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%N_SP,1) i1_u = UBOUND(OutData%N_SP,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%N_SP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%N_SP))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%N_SP) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%N_SP,1), UBOUND(OutData%N_SP,1) + OutData%N_SP(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%F_ext,1) i1_u = UBOUND(OutData%F_ext,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%F_ext = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F_ext))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F_ext) - DEALLOCATE(mask1) - OutData%Gravity = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_CMODE = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TMD_SA_MODE = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TMD_X_C_HIGH = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_X_C_LOW = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_Y_C_HIGH = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_Y_C_LOW = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_X_C_BRAKE = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%TMD_Y_C_BRAKE = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%Use_F_TBL = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%F_ext,1), UBOUND(OutData%F_ext,1) + OutData%F_ext(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%Gravity = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_CMODE = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TMD_SA_MODE = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TMD_X_C_HIGH = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_X_C_LOW = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_Y_C_HIGH = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_Y_C_LOW = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_X_C_BRAKE = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%TMD_Y_C_BRAKE = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Use_F_TBL = TRANSFER(IntKiBuf(Int_Xferred), OutData%Use_F_TBL) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F_TBL not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -2041,15 +1953,12 @@ SUBROUTINE TMD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F_TBL.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%F_TBL)>0) OutData%F_TBL = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F_TBL))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F_TBL) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%F_TBL,2), UBOUND(OutData%F_TBL,2) + DO i1 = LBOUND(OutData%F_TBL,1), UBOUND(OutData%F_TBL,1) + OutData%F_TBL(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE TMD_UnPackParam @@ -2207,12 +2116,6 @@ SUBROUTINE TMD_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'TMD_UnPackInput' @@ -2422,12 +2325,6 @@ SUBROUTINE TMD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMs INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'TMD_UnPackOutput' @@ -2558,8 +2455,8 @@ SUBROUTINE TMD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'TMD_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -2574,6 +2471,8 @@ SUBROUTINE TMD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(u1%Mesh, u2%Mesh, tin, u_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE TMD_Input_ExtrapInterp1 @@ -2605,8 +2504,9 @@ SUBROUTINE TMD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Err REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'TMD_Input_ExtrapInterp2' @@ -2628,6 +2528,8 @@ SUBROUTINE TMD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(u1%Mesh, u2%Mesh, u3%Mesh, tin, u_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE TMD_Input_ExtrapInterp2 @@ -2707,8 +2609,8 @@ SUBROUTINE TMD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'TMD_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -2723,6 +2625,8 @@ SUBROUTINE TMD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(y1%Mesh, y2%Mesh, tin, y_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE TMD_Output_ExtrapInterp1 @@ -2754,8 +2658,9 @@ SUBROUTINE TMD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Er REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'TMD_Output_ExtrapInterp2' @@ -2777,6 +2682,8 @@ SUBROUTINE TMD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(y1%Mesh, y2%Mesh, y3%Mesh, tin, y_out%Mesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) END SUBROUTINE TMD_Output_ExtrapInterp2 diff --git a/modules/subdyn/src/SubDyn.f90 b/modules/subdyn/src/SubDyn.f90 index a116c6db84..e93577dff6 100644 --- a/modules/subdyn/src/SubDyn.f90 +++ b/modules/subdyn/src/SubDyn.f90 @@ -712,7 +712,6 @@ SUBROUTINE SD_Input(SDInputFile, Init, p, ErrStat,ErrMsg) ! local variable for input and output CHARACTER(1024) :: PriPath ! The path to the primary input file CHARACTER(1024) :: Line ! String to temporarially hold value of read line -INTEGER :: Sttus LOGICAL :: Echo INTEGER(IntKi) :: UnIn diff --git a/modules/subdyn/src/SubDyn_Output.f90 b/modules/subdyn/src/SubDyn_Output.f90 index 07b7d3a190..cbd2913c47 100644 --- a/modules/subdyn/src/SubDyn_Output.f90 +++ b/modules/subdyn/src/SubDyn_Output.f90 @@ -28,6 +28,7 @@ MODULE SubDyn_Output ! The maximum number of output channels which can be output by the code. INTEGER(IntKi),PUBLIC, PARAMETER :: MaxOutPts = 2265 + INTEGER(IntKi), PARAMETER :: OutStrLenM1 = ChanLen - 1 PRIVATE @@ -2771,7 +2772,7 @@ MODULE SubDyn_Output - CHARACTER(10), PARAMETER :: ValidParamAry(2265) = (/ & ! This lists the names of the allowed parameters, which must be sorted alphabetically + CHARACTER(OutStrLenM1), PARAMETER :: ValidParamAry(2265) = (/ & ! This lists the names of the allowed parameters, which must be sorted alphabetically "INTFFXSS ","INTFFYSS ","INTFFZSS ","INTFMXSS ","INTFMYSS ","INTFMZSS ","INTFRAXSS", & "INTFRAYSS","INTFRAZSS","INTFRDXSS","INTFRDYSS","INTFRDZSS","INTFTAXSS","INTFTAYSS", & "INTFTAZSS","INTFTDXSS","INTFTDYSS","INTFTDZSS","M1N1FKXE ","M1N1FKYE ","M1N1FKZE ", & diff --git a/modules/subdyn/src/SubDyn_Registry.txt b/modules/subdyn/src/SubDyn_Registry.txt index b69c6c3c8a..248ce4ba22 100644 --- a/modules/subdyn/src/SubDyn_Registry.txt +++ b/modules/subdyn/src/SubDyn_Registry.txt @@ -18,8 +18,8 @@ typedef ^ InitInputType ReKi TP_RefPoint {3} - - "global position of transitio typedef ^ InitInputType ReKi SubRotateZ - - - "Rotation angle in degrees about global Z" # ============================== Define Initialization outputs here: ============================================================================================================================================ -typedef ^ InitOutputType CHARACTER(10) WriteOutputHdr {:} - - "Names of the output-to-file channels" - -typedef ^ InitOutputType CHARACTER(10) WriteOutputUnt {:} - - "Units of the output-to-file channels" - +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" - # ============================== Define Internal data types here: ============================================================================================================================================ @@ -87,7 +87,7 @@ typedef ^ ^ ReKi CMass {:}{:} - - "Concentrated mass information" typedef ^ ^ ReKi JDampings {:} - - "Damping coefficients for internal modes" typedef ^ ^ INTEGER Members {:}{:} - - "Member joints connection" typedef ^ ^ INTEGER Interf {:}{:} - - "Interface degree of freedoms" -typedef ^ ^ CHARACTER(10) SSOutList {:} - - "List of Output Channels" +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" #-------------------------- arrays and variables used in the module ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------ diff --git a/modules/subdyn/src/SubDyn_Types.f90 b/modules/subdyn/src/SubDyn_Types.f90 index d7ce80aaee..31efd0db7d 100644 --- a/modules/subdyn/src/SubDyn_Types.f90 +++ b/modules/subdyn/src/SubDyn_Types.f90 @@ -45,8 +45,8 @@ MODULE SubDyn_Types ! ======================= ! ========= SD_InitOutputType ======= TYPE, PUBLIC :: SD_InitOutputType - CHARACTER(10) , DIMENSION(:), ALLOCATABLE :: WriteOutputHdr !< Names of the output-to-file channels [-] - CHARACTER(10) , DIMENSION(:), ALLOCATABLE :: WriteOutputUnt !< Units of the output-to-file channels [-] + 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 [-] END TYPE SD_InitOutputType ! ======================= @@ -126,7 +126,7 @@ MODULE SubDyn_Types REAL(ReKi) , DIMENSION(:), ALLOCATABLE :: JDampings !< Damping coefficients for internal modes [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Members !< Member joints connection [-] INTEGER(IntKi) , DIMENSION(:,:), ALLOCATABLE :: Interf !< Interface degree of freedoms [-] - CHARACTER(10) , DIMENSION(:), ALLOCATABLE :: SSOutList !< List of Output Channels [-] + 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 [-] INTEGER(IntKi) :: NNode !< Total number of nodes [-] @@ -377,22 +377,24 @@ 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:Re_Xferred+(1)-1 ) = InData%g - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%WtrDpth - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TP_RefPoint))-1 ) = PACK(InData%TP_RefPoint,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TP_RefPoint) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SubRotateZ - Re_Xferred = Re_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 END SUBROUTINE SD_PackInitInput SUBROUTINE SD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -408,12 +410,6 @@ SUBROUTINE SD_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (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 @@ -431,31 +427,26 @@ 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 + 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) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%TP_RefPoint = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TP_RefPoint))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TP_RefPoint) - DEALLOCATE(mask1) - OutData%SubRotateZ = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 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 END SUBROUTINE SD_UnPackInitInput SUBROUTINE SD_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) @@ -620,12 +611,12 @@ SUBROUTINE SD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputHdr,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputHdr,1), UBOUND(InData%WriteOutputHdr,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + END DO END IF IF ( .NOT. ALLOCATED(InData%WriteOutputUnt) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -637,12 +628,12 @@ SUBROUTINE SD_PackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutputUnt,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%WriteOutputUnt,1), UBOUND(InData%WriteOutputUnt,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 + 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) @@ -687,12 +678,6 @@ SUBROUTINE SD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -720,19 +705,12 @@ SUBROUTINE SD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputHdr.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputHdr,1), UBOUND(OutData%WriteOutputHdr,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! WriteOutputUnt not allocated Int_Xferred = Int_Xferred + 1 @@ -747,19 +725,12 @@ SUBROUTINE SD_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutputUnt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%WriteOutputUnt,1), UBOUND(OutData%WriteOutputUnt,1) + 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 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) + END DO END IF Buf_size=IntKiBuf( Int_Xferred ) Int_Xferred = Int_Xferred + 1 @@ -1070,10 +1041,10 @@ SUBROUTINE SD_PackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%MemberID - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NOutCnt - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%MemberID + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NOutCnt + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%NodeCnt) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1084,8 +1055,10 @@ SUBROUTINE SD_PackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodeCnt,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%NodeCnt)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%NodeCnt))-1 ) = PACK(InData%NodeCnt,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%NodeCnt) + 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 @@ -1097,8 +1070,10 @@ SUBROUTINE SD_PackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodeIDs,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%NodeIDs)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%NodeIDs))-1 ) = PACK(InData%NodeIDs,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%NodeIDs) + 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 @@ -1113,8 +1088,12 @@ SUBROUTINE SD_PackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElmIDs,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ElmIDs)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%ElmIDs))-1 ) = PACK(InData%ElmIDs,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%ElmIDs) + 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 @@ -1129,13 +1108,21 @@ SUBROUTINE SD_PackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElmNds,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ElmNds)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%ElmNds))-1 ) = PACK(InData%ElmNds,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%ElmNds) + 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 - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%ElmID2s))-1 ) = PACK(InData%ElmID2s,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%ElmID2s) - IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%ElmNd2s))-1 ) = PACK(InData%ElmNd2s,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%ElmNd2s) + DO i1 = LBOUND(InData%ElmID2s,1), UBOUND(InData%ElmID2s,1) + IntKiBuf(Int_Xferred) = InData%ElmID2s(i1) + Int_Xferred = Int_Xferred + 1 + END DO + DO i1 = LBOUND(InData%ElmNd2s,1), UBOUND(InData%ElmNd2s,1) + IntKiBuf(Int_Xferred) = InData%ElmNd2s(i1) + Int_Xferred = Int_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%Me) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1155,8 +1142,16 @@ SUBROUTINE SD_PackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Me,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Me)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Me))-1 ) = PACK(InData%Me,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Me) + 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) + ReKiBuf(Re_Xferred) = InData%Me(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Ke) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1177,8 +1172,16 @@ SUBROUTINE SD_PackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Ke,4) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Ke)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Ke))-1 ) = PACK(InData%Ke,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Ke) + 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) + ReKiBuf(Re_Xferred) = InData%Ke(i1,i2,i3,i4) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Fg) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1196,15 +1199,37 @@ SUBROUTINE SD_PackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Fg,3) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Fg)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Fg))-1 ) = PACK(InData%Fg,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Fg) - END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Me2))-1 ) = PACK(InData%Me2,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Me2) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Ke2))-1 ) = PACK(InData%Ke2,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Ke2) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Fg2))-1 ) = PACK(InData%Fg2,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Fg2) + 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) + ReKiBuf(Re_Xferred) = InData%Fg(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END IF + DO i3 = LBOUND(InData%Me2,3), UBOUND(InData%Me2,3) + DO i2 = LBOUND(InData%Me2,2), UBOUND(InData%Me2,2) + DO i1 = LBOUND(InData%Me2,1), UBOUND(InData%Me2,1) + ReKiBuf(Re_Xferred) = InData%Me2(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + DO i3 = LBOUND(InData%Ke2,3), UBOUND(InData%Ke2,3) + DO i2 = LBOUND(InData%Ke2,2), UBOUND(InData%Ke2,2) + DO i1 = LBOUND(InData%Ke2,1), UBOUND(InData%Ke2,1) + ReKiBuf(Re_Xferred) = InData%Ke2(i1,i2,i3) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + DO i2 = LBOUND(InData%Fg2,2), UBOUND(InData%Fg2,2) + DO i1 = LBOUND(InData%Fg2,1), UBOUND(InData%Fg2,1) + ReKiBuf(Re_Xferred) = InData%Fg2(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END SUBROUTINE SD_PackMeshAuxDataType SUBROUTINE SD_UnPackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -1220,12 +1245,6 @@ SUBROUTINE SD_UnPackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (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 @@ -1243,10 +1262,10 @@ SUBROUTINE SD_UnPackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta 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 + 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 @@ -1260,15 +1279,10 @@ SUBROUTINE SD_UnPackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodeCnt.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%NodeCnt)>0) OutData%NodeCnt = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%NodeCnt))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%NodeCnt) - DEALLOCATE(mask1) + 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 @@ -1283,15 +1297,10 @@ SUBROUTINE SD_UnPackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodeIDs.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%NodeIDs)>0) OutData%NodeIDs = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%NodeIDs))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%NodeIDs) - DEALLOCATE(mask1) + 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 @@ -1309,15 +1318,12 @@ SUBROUTINE SD_UnPackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElmIDs.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%ElmIDs)>0) OutData%ElmIDs = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%ElmIDs))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%ElmIDs) - DEALLOCATE(mask2) + 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 @@ -1335,38 +1341,25 @@ SUBROUTINE SD_UnPackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElmNds.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%ElmNds)>0) OutData%ElmNds = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%ElmNds))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%ElmNds) - DEALLOCATE(mask2) + 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 i1_l = LBOUND(OutData%ElmID2s,1) i1_u = UBOUND(OutData%ElmID2s,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%ElmID2s = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%ElmID2s))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%ElmID2s) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%ElmID2s,1), UBOUND(OutData%ElmID2s,1) + OutData%ElmID2s(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO i1_l = LBOUND(OutData%ElmNd2s,1) i1_u = UBOUND(OutData%ElmNd2s,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%ElmNd2s = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%ElmNd2s))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%ElmNd2s) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%ElmNd2s,1), UBOUND(OutData%ElmNd2s,1) + OutData%ElmNd2s(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Me not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1389,15 +1382,16 @@ SUBROUTINE SD_UnPackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Me.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%Me)>0) OutData%Me = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Me))-1 ), mask4, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Me) - DEALLOCATE(mask4) + 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) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Ke not allocated Int_Xferred = Int_Xferred + 1 @@ -1421,15 +1415,16 @@ SUBROUTINE SD_UnPackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Ke.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask4(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 mask4.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask4 = .TRUE. - IF (SIZE(OutData%Ke)>0) OutData%Ke = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Ke))-1 ), mask4, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Ke) - DEALLOCATE(mask4) + 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) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_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 @@ -1450,15 +1445,14 @@ SUBROUTINE SD_UnPackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Fg.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - IF (SIZE(OutData%Fg)>0) OutData%Fg = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Fg))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Fg) - DEALLOCATE(mask3) + 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) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO END IF i1_l = LBOUND(OutData%Me2,1) i1_u = UBOUND(OutData%Me2,1) @@ -1466,43 +1460,38 @@ SUBROUTINE SD_UnPackMeshAuxDataType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrSta i2_u = UBOUND(OutData%Me2,2) i3_l = LBOUND(OutData%Me2,3) i3_u = UBOUND(OutData%Me2,3) - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - OutData%Me2 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Me2))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Me2) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%Me2,3), UBOUND(OutData%Me2,3) + DO i2 = LBOUND(OutData%Me2,2), UBOUND(OutData%Me2,2) + DO i1 = LBOUND(OutData%Me2,1), UBOUND(OutData%Me2,1) + OutData%Me2(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO i1_l = LBOUND(OutData%Ke2,1) i1_u = UBOUND(OutData%Ke2,1) i2_l = LBOUND(OutData%Ke2,2) i2_u = UBOUND(OutData%Ke2,2) i3_l = LBOUND(OutData%Ke2,3) i3_u = UBOUND(OutData%Ke2,3) - ALLOCATE(mask3(i1_l:i1_u,i2_l:i2_u,i3_l:i3_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask3.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask3 = .TRUE. - OutData%Ke2 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Ke2))-1 ), mask3, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Ke2) - DEALLOCATE(mask3) + DO i3 = LBOUND(OutData%Ke2,3), UBOUND(OutData%Ke2,3) + DO i2 = LBOUND(OutData%Ke2,2), UBOUND(OutData%Ke2,2) + DO i1 = LBOUND(OutData%Ke2,1), UBOUND(OutData%Ke2,1) + OutData%Ke2(i1,i2,i3) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO + END DO i1_l = LBOUND(OutData%Fg2,1) i1_u = UBOUND(OutData%Fg2,1) i2_l = LBOUND(OutData%Fg2,2) i2_u = UBOUND(OutData%Fg2,2) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%Fg2 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Fg2))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Fg2) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Fg2,2), UBOUND(OutData%Fg2,2) + DO i1 = LBOUND(OutData%Fg2,1), UBOUND(OutData%Fg2,1) + OutData%Fg2(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END SUBROUTINE SD_UnPackMeshAuxDataType SUBROUTINE SD_CopyCB_MatArrays( SrcCB_MatArraysData, DstCB_MatArraysData, CtrlCode, ErrStat, ErrMsg ) @@ -1750,8 +1739,8 @@ SUBROUTINE SD_PackCB_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DOFM - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DOFM + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%TI2) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -1765,8 +1754,12 @@ SUBROUTINE SD_PackCB_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TI2,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TI2)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TI2))-1 ) = PACK(InData%TI2,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TI2) + DO i2 = LBOUND(InData%TI2,2), UBOUND(InData%TI2,2) + DO i1 = LBOUND(InData%TI2,1), UBOUND(InData%TI2,1) + ReKiBuf(Re_Xferred) = InData%TI2(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%MBB) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1781,8 +1774,12 @@ SUBROUTINE SD_PackCB_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MBB,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%MBB)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MBB))-1 ) = PACK(InData%MBB,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MBB) + DO i2 = LBOUND(InData%MBB,2), UBOUND(InData%MBB,2) + DO i1 = LBOUND(InData%MBB,1), UBOUND(InData%MBB,1) + ReKiBuf(Re_Xferred) = InData%MBB(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%MBM) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1797,8 +1794,12 @@ SUBROUTINE SD_PackCB_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MBM,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%MBM)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MBM))-1 ) = PACK(InData%MBM,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MBM) + DO i2 = LBOUND(InData%MBM,2), UBOUND(InData%MBM,2) + DO i1 = LBOUND(InData%MBM,1), UBOUND(InData%MBM,1) + ReKiBuf(Re_Xferred) = InData%MBM(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%KBB) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1813,8 +1814,12 @@ SUBROUTINE SD_PackCB_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%KBB,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%KBB)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%KBB))-1 ) = PACK(InData%KBB,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%KBB) + DO i2 = LBOUND(InData%KBB,2), UBOUND(InData%KBB,2) + DO i1 = LBOUND(InData%KBB,1), UBOUND(InData%KBB,1) + ReKiBuf(Re_Xferred) = InData%KBB(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PhiL) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1829,8 +1834,12 @@ SUBROUTINE SD_PackCB_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiL,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PhiL)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PhiL))-1 ) = PACK(InData%PhiL,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PhiL) + DO i2 = LBOUND(InData%PhiL,2), UBOUND(InData%PhiL,2) + DO i1 = LBOUND(InData%PhiL,1), UBOUND(InData%PhiL,1) + ReKiBuf(Re_Xferred) = InData%PhiL(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PhiR) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1845,8 +1854,12 @@ SUBROUTINE SD_PackCB_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiR,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PhiR)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PhiR))-1 ) = PACK(InData%PhiR,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PhiR) + DO i2 = LBOUND(InData%PhiR,2), UBOUND(InData%PhiR,2) + DO i1 = LBOUND(InData%PhiR,1), UBOUND(InData%PhiR,1) + ReKiBuf(Re_Xferred) = InData%PhiR(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%OmegaL) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -1858,8 +1871,10 @@ SUBROUTINE SD_PackCB_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err IntKiBuf( Int_Xferred + 1) = UBOUND(InData%OmegaL,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%OmegaL)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%OmegaL))-1 ) = PACK(InData%OmegaL,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%OmegaL) + DO i1 = LBOUND(InData%OmegaL,1), UBOUND(InData%OmegaL,1) + ReKiBuf(Re_Xferred) = InData%OmegaL(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE SD_PackCB_MatArrays @@ -1876,12 +1891,6 @@ SUBROUTINE SD_UnPackCB_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -1897,8 +1906,8 @@ SUBROUTINE SD_UnPackCB_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DOFM = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%DOFM = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TI2 not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -1915,15 +1924,12 @@ SUBROUTINE SD_UnPackCB_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TI2.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%TI2)>0) OutData%TI2 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TI2))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TI2) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%TI2,2), UBOUND(OutData%TI2,2) + DO i1 = LBOUND(OutData%TI2,1), UBOUND(OutData%TI2,1) + OutData%TI2(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MBB not allocated Int_Xferred = Int_Xferred + 1 @@ -1941,15 +1947,12 @@ SUBROUTINE SD_UnPackCB_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MBB.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%MBB)>0) OutData%MBB = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MBB))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%MBB) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%MBB,2), UBOUND(OutData%MBB,2) + DO i1 = LBOUND(OutData%MBB,1), UBOUND(OutData%MBB,1) + OutData%MBB(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MBM not allocated Int_Xferred = Int_Xferred + 1 @@ -1967,15 +1970,12 @@ SUBROUTINE SD_UnPackCB_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MBM.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%MBM)>0) OutData%MBM = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MBM))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%MBM) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%MBM,2), UBOUND(OutData%MBM,2) + DO i1 = LBOUND(OutData%MBM,1), UBOUND(OutData%MBM,1) + OutData%MBM(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! KBB not allocated Int_Xferred = Int_Xferred + 1 @@ -1993,15 +1993,12 @@ SUBROUTINE SD_UnPackCB_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%KBB.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%KBB)>0) OutData%KBB = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%KBB))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%KBB) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%KBB,2), UBOUND(OutData%KBB,2) + DO i1 = LBOUND(OutData%KBB,1), UBOUND(OutData%KBB,1) + OutData%KBB(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PhiL not allocated Int_Xferred = Int_Xferred + 1 @@ -2019,15 +2016,12 @@ SUBROUTINE SD_UnPackCB_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiL.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PhiL)>0) OutData%PhiL = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PhiL))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PhiL) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PhiL,2), UBOUND(OutData%PhiL,2) + DO i1 = LBOUND(OutData%PhiL,1), UBOUND(OutData%PhiL,1) + OutData%PhiL(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PhiR not allocated Int_Xferred = Int_Xferred + 1 @@ -2045,15 +2039,12 @@ SUBROUTINE SD_UnPackCB_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiR.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PhiR)>0) OutData%PhiR = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PhiR))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PhiR) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PhiR,2), UBOUND(OutData%PhiR,2) + DO i1 = LBOUND(OutData%PhiR,1), UBOUND(OutData%PhiR,1) + OutData%PhiR(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! OmegaL not allocated Int_Xferred = Int_Xferred + 1 @@ -2068,15 +2059,10 @@ SUBROUTINE SD_UnPackCB_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%OmegaL.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%OmegaL)>0) OutData%OmegaL = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%OmegaL))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%OmegaL) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%OmegaL,1), UBOUND(OutData%OmegaL,1) + OutData%OmegaL(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE SD_UnPackCB_MatArrays @@ -2225,11 +2211,13 @@ SUBROUTINE SD_PackFEM_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Omega,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Omega)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Omega))-1 ) = PACK(InData%Omega,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Omega) + DO i1 = LBOUND(InData%Omega,1), UBOUND(InData%Omega,1) + ReKiBuf(Re_Xferred) = InData%Omega(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NOmega - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NOmega + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%Modes) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -2243,8 +2231,12 @@ SUBROUTINE SD_PackFEM_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Er IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Modes,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Modes)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Modes))-1 ) = PACK(InData%Modes,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Modes) + DO i2 = LBOUND(InData%Modes,2), UBOUND(InData%Modes,2) + DO i1 = LBOUND(InData%Modes,1), UBOUND(InData%Modes,1) + ReKiBuf(Re_Xferred) = InData%Modes(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE SD_PackFEM_MatArrays @@ -2261,12 +2253,6 @@ SUBROUTINE SD_UnPackFEM_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -2295,18 +2281,13 @@ SUBROUTINE SD_UnPackFEM_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Omega.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%Omega)>0) OutData%Omega = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Omega))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Omega) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%Omega,1), UBOUND(OutData%Omega,1) + OutData%Omega(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%NOmega = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NOmega = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Modes not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -2323,15 +2304,12 @@ SUBROUTINE SD_UnPackFEM_MatArrays( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Modes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Modes)>0) OutData%Modes = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Modes))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Modes) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Modes,2), UBOUND(OutData%Modes,2) + DO i1 = LBOUND(OutData%Modes,1), UBOUND(OutData%Modes,1) + OutData%Modes(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF END SUBROUTINE SD_UnPackFEM_MatArrays @@ -2448,28 +2426,32 @@ SUBROUTINE SD_PackElemPropType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, Err Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Area - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Length - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Ixx - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Iyy - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Jzz - Re_Xferred = Re_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%Shear , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Kappa - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%YoungE - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%ShearG - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%Rho - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%DirCos))-1 ) = PACK(InData%DirCos,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%DirCos) + ReKiBuf(Re_Xferred) = InData%Area + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Length + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Ixx + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Iyy + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Jzz + Re_Xferred = Re_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%Shear, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%Kappa + 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%Rho + 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) + ReKiBuf(Re_Xferred) = InData%DirCos(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END SUBROUTINE SD_PackElemPropType SUBROUTINE SD_UnPackElemPropType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -2485,12 +2467,6 @@ SUBROUTINE SD_UnPackElemPropType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -2506,39 +2482,36 @@ SUBROUTINE SD_UnPackElemPropType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%Area = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_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 ), mask0 ) - 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%Rho = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%Area = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Length = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Ixx = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Iyy = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Jzz = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%Shear = TRANSFER(IntKiBuf(Int_Xferred), OutData%Shear) + Int_Xferred = Int_Xferred + 1 + OutData%Kappa = 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%Rho = 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) - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - OutData%DirCos = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%DirCos))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%DirCos) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%DirCos,2), UBOUND(OutData%DirCos,2) + DO i1 = LBOUND(OutData%DirCos,1), UBOUND(OutData%DirCos,1) + OutData%DirCos(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END SUBROUTINE SD_UnPackElemPropType SUBROUTINE SD_CopyInitType( SrcInitTypeData, DstInitTypeData, CtrlCode, ErrStat, ErrMsg ) @@ -3128,36 +3101,38 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(InData%RootName) - IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TP_RefPoint))-1 ) = PACK(InData%TP_RefPoint,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TP_RefPoint) - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%SubRotateZ - Re_Xferred = Re_Xferred + 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%g - Re_Xferred = Re_Xferred + 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%DT - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NJoints - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NPropSets - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NXPropSets - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NInterf - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NCMass - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NCOSMs - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%FEMMod - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NDiv - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%CBMod , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%RootName) + IntKiBuf(Int_Xferred) = ICHAR(InData%RootName(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO i1 = LBOUND(InData%TP_RefPoint,1), UBOUND(InData%TP_RefPoint,1) + ReKiBuf(Re_Xferred) = InData%TP_RefPoint(i1) + Re_Xferred = Re_Xferred + 1 + END DO + ReKiBuf(Re_Xferred) = InData%SubRotateZ + Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%g + Re_Xferred = Re_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%DT + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NJoints + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NPropSets + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NXPropSets + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NInterf + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NCMass + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NCOSMs + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%FEMMod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NDiv + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%CBMod, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%Joints) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -3171,8 +3146,12 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Joints,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Joints)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Joints))-1 ) = PACK(InData%Joints,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Joints) + DO i2 = LBOUND(InData%Joints,2), UBOUND(InData%Joints,2) + DO i1 = LBOUND(InData%Joints,1), UBOUND(InData%Joints,1) + ReKiBuf(Re_Xferred) = InData%Joints(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PropSets) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3187,8 +3166,12 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PropSets,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PropSets)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PropSets))-1 ) = PACK(InData%PropSets,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PropSets) + DO i2 = LBOUND(InData%PropSets,2), UBOUND(InData%PropSets,2) + DO i1 = LBOUND(InData%PropSets,1), UBOUND(InData%PropSets,1) + ReKiBuf(Re_Xferred) = InData%PropSets(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%XPropSets) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3203,8 +3186,12 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%XPropSets,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%XPropSets)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%XPropSets))-1 ) = PACK(InData%XPropSets,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%XPropSets) + DO i2 = LBOUND(InData%XPropSets,2), UBOUND(InData%XPropSets,2) + DO i1 = LBOUND(InData%XPropSets,1), UBOUND(InData%XPropSets,1) + ReKiBuf(Re_Xferred) = InData%XPropSets(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%COSMs) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3219,8 +3206,12 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%COSMs,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%COSMs)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%COSMs))-1 ) = PACK(InData%COSMs,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%COSMs) + DO i2 = LBOUND(InData%COSMs,2), UBOUND(InData%COSMs,2) + DO i1 = LBOUND(InData%COSMs,1), UBOUND(InData%COSMs,1) + ReKiBuf(Re_Xferred) = InData%COSMs(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%CMass) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3235,8 +3226,12 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%CMass,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%CMass)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%CMass))-1 ) = PACK(InData%CMass,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%CMass) + DO i2 = LBOUND(InData%CMass,2), UBOUND(InData%CMass,2) + DO i1 = LBOUND(InData%CMass,1), UBOUND(InData%CMass,1) + ReKiBuf(Re_Xferred) = InData%CMass(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%JDampings) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3248,8 +3243,10 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%JDampings,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%JDampings)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%JDampings))-1 ) = PACK(InData%JDampings,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%JDampings) + DO i1 = LBOUND(InData%JDampings,1), UBOUND(InData%JDampings,1) + ReKiBuf(Re_Xferred) = InData%JDampings(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%Members) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3264,8 +3261,12 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Members,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Members)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%Members))-1 ) = PACK(InData%Members,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%Members) + DO i2 = LBOUND(InData%Members,2), UBOUND(InData%Members,2) + DO i1 = LBOUND(InData%Members,1), UBOUND(InData%Members,1) + IntKiBuf(Int_Xferred) = InData%Members(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Interf) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3280,8 +3281,12 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Interf,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Interf)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%Interf))-1 ) = PACK(InData%Interf,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%Interf) + DO i2 = LBOUND(InData%Interf,2), UBOUND(InData%Interf,2) + DO i1 = LBOUND(InData%Interf,1), UBOUND(InData%Interf,1) + IntKiBuf(Int_Xferred) = InData%Interf(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%SSOutList) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3293,25 +3298,25 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SSOutList,1) Int_Xferred = Int_Xferred + 2 - DO i1 = LBOUND(InData%SSOutList,1), UBOUND(InData%SSOutList,1) + DO i1 = LBOUND(InData%SSOutList,1), UBOUND(InData%SSOutList,1) DO I = 1, LEN(InData%SSOutList) IntKiBuf(Int_Xferred) = ICHAR(InData%SSOutList(i1)(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%OutCOSM , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%TabDelim , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NNode - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NElem - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NProp - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%TDOF - Int_Xferred = Int_Xferred + 1 + END DO + END IF + IntKiBuf(Int_Xferred) = TRANSFER(InData%OutCOSM, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%TabDelim, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NNode + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NElem + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NProp + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%TDOF + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%Nodes) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -3325,8 +3330,12 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Nodes,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Nodes)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Nodes))-1 ) = PACK(InData%Nodes,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Nodes) + DO i2 = LBOUND(InData%Nodes,2), UBOUND(InData%Nodes,2) + DO i1 = LBOUND(InData%Nodes,1), UBOUND(InData%Nodes,1) + ReKiBuf(Re_Xferred) = InData%Nodes(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%Props) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3341,8 +3350,12 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Props,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Props)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%Props))-1 ) = PACK(InData%Props,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%Props) + DO i2 = LBOUND(InData%Props,2), UBOUND(InData%Props,2) + DO i1 = LBOUND(InData%Props,1), UBOUND(InData%Props,1) + ReKiBuf(Re_Xferred) = InData%Props(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%K) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3357,8 +3370,12 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%K,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%K)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%K))-1 ) = PACK(InData%K,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%K) + DO i2 = LBOUND(InData%K,2), UBOUND(InData%K,2) + DO i1 = LBOUND(InData%K,1), UBOUND(InData%K,1) + ReKiBuf(Re_Xferred) = InData%K(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%M) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3373,8 +3390,12 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%M,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%M)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%M))-1 ) = PACK(InData%M,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%M) + DO i2 = LBOUND(InData%M,2), UBOUND(InData%M,2) + DO i1 = LBOUND(InData%M,1), UBOUND(InData%M,1) + ReKiBuf(Re_Xferred) = InData%M(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%F) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3386,8 +3407,10 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%F)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F))-1 ) = PACK(InData%F,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F) + DO i1 = LBOUND(InData%F,1), UBOUND(InData%F,1) + ReKiBuf(Re_Xferred) = InData%F(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%FG) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3399,8 +3422,10 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FG,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FG)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FG))-1 ) = PACK(InData%FG,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FG) + DO i1 = LBOUND(InData%FG,1), UBOUND(InData%FG,1) + ReKiBuf(Re_Xferred) = InData%FG(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%ElemProps) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3415,8 +3440,12 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%ElemProps,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%ElemProps)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%ElemProps))-1 ) = PACK(InData%ElemProps,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%ElemProps) + DO i2 = LBOUND(InData%ElemProps,2), UBOUND(InData%ElemProps,2) + DO i1 = LBOUND(InData%ElemProps,1), UBOUND(InData%ElemProps,1) + ReKiBuf(Re_Xferred) = InData%ElemProps(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%BCs) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3431,8 +3460,12 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%BCs,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%BCs)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%BCs))-1 ) = PACK(InData%BCs,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%BCs) + DO i2 = LBOUND(InData%BCs,2), UBOUND(InData%BCs,2) + DO i1 = LBOUND(InData%BCs,1), UBOUND(InData%BCs,1) + IntKiBuf(Int_Xferred) = InData%BCs(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%IntFc) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3447,8 +3480,12 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IntFc,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%IntFc)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%IntFc))-1 ) = PACK(InData%IntFc,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%IntFc) + DO i2 = LBOUND(InData%IntFc,2), UBOUND(InData%IntFc,2) + DO i1 = LBOUND(InData%IntFc,1), UBOUND(InData%IntFc,1) + IntKiBuf(Int_Xferred) = InData%IntFc(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%MemberNodes) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3463,8 +3500,12 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MemberNodes,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%MemberNodes)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%MemberNodes))-1 ) = PACK(InData%MemberNodes,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%MemberNodes) + DO i2 = LBOUND(InData%MemberNodes,2), UBOUND(InData%MemberNodes,2) + DO i1 = LBOUND(InData%MemberNodes,1), UBOUND(InData%MemberNodes,1) + IntKiBuf(Int_Xferred) = InData%MemberNodes(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%NodesConnN) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3479,8 +3520,12 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodesConnN,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%NodesConnN)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%NodesConnN))-1 ) = PACK(InData%NodesConnN,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%NodesConnN) + DO i2 = LBOUND(InData%NodesConnN,2), UBOUND(InData%NodesConnN,2) + DO i1 = LBOUND(InData%NodesConnN,1), UBOUND(InData%NodesConnN,1) + IntKiBuf(Int_Xferred) = InData%NodesConnN(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%NodesConnE) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -3495,11 +3540,15 @@ SUBROUTINE SD_PackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NodesConnE,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%NodesConnE)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%NodesConnE))-1 ) = PACK(InData%NodesConnE,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%NodesConnE) + DO i2 = LBOUND(InData%NodesConnE,2), UBOUND(InData%NodesConnE,2) + DO i1 = LBOUND(InData%NodesConnE,1), UBOUND(InData%NodesConnE,1) + IntKiBuf(Int_Xferred) = InData%NodesConnE(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%SSSum , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%SSSum, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE SD_PackInitType SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -3515,12 +3564,6 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -3536,45 +3579,40 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - DO I = 1, LEN(OutData%RootName) - OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO I = 1, LEN(OutData%RootName) + OutData%RootName(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I i1_l = LBOUND(OutData%TP_RefPoint,1) i1_u = UBOUND(OutData%TP_RefPoint,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%TP_RefPoint = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TP_RefPoint))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TP_RefPoint) - DEALLOCATE(mask1) - OutData%SubRotateZ = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%g = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 - OutData%DT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%NJoints = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NPropSets = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NXPropSets = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NInterf = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NCMass = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NCOSMs = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%FEMMod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NDiv = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%CBMod = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + DO i1 = LBOUND(OutData%TP_RefPoint,1), UBOUND(OutData%TP_RefPoint,1) + OutData%TP_RefPoint(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + OutData%SubRotateZ = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%g = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + OutData%DT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%NJoints = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NPropSets = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NXPropSets = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NInterf = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NCMass = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NCOSMs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%FEMMod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NDiv = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%CBMod = TRANSFER(IntKiBuf(Int_Xferred), OutData%CBMod) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Joints not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3591,15 +3629,12 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Joints.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Joints)>0) OutData%Joints = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Joints))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Joints) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Joints,2), UBOUND(OutData%Joints,2) + DO i1 = LBOUND(OutData%Joints,1), UBOUND(OutData%Joints,1) + OutData%Joints(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PropSets not allocated Int_Xferred = Int_Xferred + 1 @@ -3617,15 +3652,12 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PropSets.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PropSets)>0) OutData%PropSets = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PropSets))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PropSets) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PropSets,2), UBOUND(OutData%PropSets,2) + DO i1 = LBOUND(OutData%PropSets,1), UBOUND(OutData%PropSets,1) + OutData%PropSets(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! XPropSets not allocated Int_Xferred = Int_Xferred + 1 @@ -3643,15 +3675,12 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%XPropSets.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%XPropSets)>0) OutData%XPropSets = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%XPropSets))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%XPropSets) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%XPropSets,2), UBOUND(OutData%XPropSets,2) + DO i1 = LBOUND(OutData%XPropSets,1), UBOUND(OutData%XPropSets,1) + OutData%XPropSets(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! COSMs not allocated Int_Xferred = Int_Xferred + 1 @@ -3669,15 +3698,12 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%COSMs.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%COSMs)>0) OutData%COSMs = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%COSMs))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%COSMs) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%COSMs,2), UBOUND(OutData%COSMs,2) + DO i1 = LBOUND(OutData%COSMs,1), UBOUND(OutData%COSMs,1) + OutData%COSMs(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! CMass not allocated Int_Xferred = Int_Xferred + 1 @@ -3695,15 +3721,12 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%CMass.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%CMass)>0) OutData%CMass = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%CMass))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%CMass) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%CMass,2), UBOUND(OutData%CMass,2) + DO i1 = LBOUND(OutData%CMass,1), UBOUND(OutData%CMass,1) + OutData%CMass(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! JDampings not allocated Int_Xferred = Int_Xferred + 1 @@ -3718,15 +3741,10 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%JDampings.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%JDampings)>0) OutData%JDampings = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%JDampings))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%JDampings) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%JDampings,1), UBOUND(OutData%JDampings,1) + OutData%JDampings(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Members not allocated Int_Xferred = Int_Xferred + 1 @@ -3744,15 +3762,12 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Members.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Members)>0) OutData%Members = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%Members))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%Members) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Members,2), UBOUND(OutData%Members,2) + DO i1 = LBOUND(OutData%Members,1), UBOUND(OutData%Members,1) + OutData%Members(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Interf not allocated Int_Xferred = Int_Xferred + 1 @@ -3770,15 +3785,12 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Interf.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Interf)>0) OutData%Interf = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%Interf))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%Interf) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Interf,2), UBOUND(OutData%Interf,2) + DO i1 = LBOUND(OutData%Interf,1), UBOUND(OutData%Interf,1) + OutData%Interf(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SSOutList not allocated Int_Xferred = Int_Xferred + 1 @@ -3793,32 +3805,25 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SSOutList.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - DO i1 = LBOUND(OutData%SSOutList,1), UBOUND(OutData%SSOutList,1) + DO i1 = LBOUND(OutData%SSOutList,1), UBOUND(OutData%SSOutList,1) DO I = 1, LEN(OutData%SSOutList) OutData%SSOutList(i1)(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 + Int_Xferred = Int_Xferred + 1 END DO ! I - END DO !i1 - DEALLOCATE(mask1) - END IF - OutData%OutCOSM = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%TabDelim = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%NNode = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NElem = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NProp = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%TDOF = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + END DO + END IF + OutData%OutCOSM = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutCOSM) + Int_Xferred = Int_Xferred + 1 + OutData%TabDelim = TRANSFER(IntKiBuf(Int_Xferred), OutData%TabDelim) + Int_Xferred = Int_Xferred + 1 + OutData%NNode = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NElem = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NProp = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%TDOF = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Nodes not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -3835,15 +3840,12 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Nodes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Nodes)>0) OutData%Nodes = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Nodes))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Nodes) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Nodes,2), UBOUND(OutData%Nodes,2) + DO i1 = LBOUND(OutData%Nodes,1), UBOUND(OutData%Nodes,1) + OutData%Nodes(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Props not allocated Int_Xferred = Int_Xferred + 1 @@ -3861,15 +3863,12 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Props.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Props)>0) OutData%Props = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%Props))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%Props) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Props,2), UBOUND(OutData%Props,2) + DO i1 = LBOUND(OutData%Props,1), UBOUND(OutData%Props,1) + OutData%Props(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! K not allocated Int_Xferred = Int_Xferred + 1 @@ -3887,15 +3886,12 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%K.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%K)>0) OutData%K = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%K))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%K) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%K,2), UBOUND(OutData%K,2) + DO i1 = LBOUND(OutData%K,1), UBOUND(OutData%K,1) + OutData%K(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! M not allocated Int_Xferred = Int_Xferred + 1 @@ -3913,15 +3909,12 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%M.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%M)>0) OutData%M = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%M))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%M) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%M,2), UBOUND(OutData%M,2) + DO i1 = LBOUND(OutData%M,1), UBOUND(OutData%M,1) + OutData%M(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F not allocated Int_Xferred = Int_Xferred + 1 @@ -3936,15 +3929,10 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%F)>0) OutData%F = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%F,1), UBOUND(OutData%F,1) + OutData%F(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FG not allocated Int_Xferred = Int_Xferred + 1 @@ -3959,15 +3947,10 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FG.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%FG)>0) OutData%FG = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FG))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FG) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FG,1), UBOUND(OutData%FG,1) + OutData%FG(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! ElemProps not allocated Int_Xferred = Int_Xferred + 1 @@ -3985,15 +3968,12 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%ElemProps.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%ElemProps)>0) OutData%ElemProps = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%ElemProps))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%ElemProps) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%ElemProps,2), UBOUND(OutData%ElemProps,2) + DO i1 = LBOUND(OutData%ElemProps,1), UBOUND(OutData%ElemProps,1) + OutData%ElemProps(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! BCs not allocated Int_Xferred = Int_Xferred + 1 @@ -4011,15 +3991,12 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%BCs.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%BCs)>0) OutData%BCs = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%BCs))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%BCs) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%BCs,2), UBOUND(OutData%BCs,2) + DO i1 = LBOUND(OutData%BCs,1), UBOUND(OutData%BCs,1) + OutData%BCs(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IntFc not allocated Int_Xferred = Int_Xferred + 1 @@ -4037,15 +4014,12 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IntFc.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%IntFc)>0) OutData%IntFc = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%IntFc))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%IntFc) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%IntFc,2), UBOUND(OutData%IntFc,2) + DO i1 = LBOUND(OutData%IntFc,1), UBOUND(OutData%IntFc,1) + OutData%IntFc(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MemberNodes not allocated Int_Xferred = Int_Xferred + 1 @@ -4063,15 +4037,12 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MemberNodes.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%MemberNodes)>0) OutData%MemberNodes = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%MemberNodes))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%MemberNodes) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%MemberNodes,2), UBOUND(OutData%MemberNodes,2) + DO i1 = LBOUND(OutData%MemberNodes,1), UBOUND(OutData%MemberNodes,1) + OutData%MemberNodes(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NodesConnN not allocated Int_Xferred = Int_Xferred + 1 @@ -4089,15 +4060,12 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodesConnN.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%NodesConnN)>0) OutData%NodesConnN = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%NodesConnN))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%NodesConnN) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%NodesConnN,2), UBOUND(OutData%NodesConnN,2) + DO i1 = LBOUND(OutData%NodesConnN,1), UBOUND(OutData%NodesConnN,1) + OutData%NodesConnN(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NodesConnE not allocated Int_Xferred = Int_Xferred + 1 @@ -4115,18 +4083,15 @@ SUBROUTINE SD_UnPackInitType( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NodesConnE.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%NodesConnE)>0) OutData%NodesConnE = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%NodesConnE))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%NodesConnE) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%NodesConnE,2), UBOUND(OutData%NodesConnE,2) + DO i1 = LBOUND(OutData%NodesConnE,1), UBOUND(OutData%NodesConnE,1) + OutData%NodesConnE(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF - OutData%SSSum = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%SSSum = TRANSFER(IntKiBuf(Int_Xferred), OutData%SSSum) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE SD_UnPackInitType SUBROUTINE SD_CopyContState( SrcContStateData, DstContStateData, CtrlCode, ErrStat, ErrMsg ) @@ -4269,8 +4234,10 @@ SUBROUTINE SD_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%qm,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%qm)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%qm))-1 ) = PACK(InData%qm,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%qm) + DO i1 = LBOUND(InData%qm,1), UBOUND(InData%qm,1) + ReKiBuf(Re_Xferred) = InData%qm(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%qmdot) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -4282,8 +4249,10 @@ SUBROUTINE SD_PackContState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg IntKiBuf( Int_Xferred + 1) = UBOUND(InData%qmdot,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%qmdot)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%qmdot))-1 ) = PACK(InData%qmdot,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%qmdot) + DO i1 = LBOUND(InData%qmdot,1), UBOUND(InData%qmdot,1) + ReKiBuf(Re_Xferred) = InData%qmdot(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE SD_PackContState @@ -4300,12 +4269,6 @@ SUBROUTINE SD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -4333,15 +4296,10 @@ SUBROUTINE SD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%qm.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%qm)>0) OutData%qm = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%qm))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%qm) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%qm,1), UBOUND(OutData%qm,1) + OutData%qm(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! qmdot not allocated Int_Xferred = Int_Xferred + 1 @@ -4356,15 +4314,10 @@ SUBROUTINE SD_UnPackContState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%qmdot.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%qmdot)>0) OutData%qmdot = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%qmdot))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%qmdot) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%qmdot,1), UBOUND(OutData%qmdot,1) + OutData%qmdot(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE SD_UnPackContState @@ -4459,8 +4412,8 @@ SUBROUTINE SD_PackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyDiscState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyDiscState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE SD_PackDiscState SUBROUTINE SD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -4476,12 +4429,6 @@ SUBROUTINE SD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackDiscState' @@ -4495,8 +4442,8 @@ SUBROUTINE SD_UnPackDiscState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyDiscState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyDiscState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE SD_UnPackDiscState SUBROUTINE SD_CopyConstrState( SrcConstrStateData, DstConstrStateData, CtrlCode, ErrStat, ErrMsg ) @@ -4590,8 +4537,8 @@ SUBROUTINE SD_PackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrM Db_Xferred = 1 Int_Xferred = 1 - ReKiBuf ( Re_Xferred:Re_Xferred+(1)-1 ) = InData%DummyConstrState - Re_Xferred = Re_Xferred + 1 + ReKiBuf(Re_Xferred) = InData%DummyConstrState + Re_Xferred = Re_Xferred + 1 END SUBROUTINE SD_PackConstrState SUBROUTINE SD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -4607,12 +4554,6 @@ SUBROUTINE SD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackConstrState' @@ -4626,8 +4567,8 @@ SUBROUTINE SD_UnPackConstrState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, E Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%DummyConstrState = ReKiBuf( Re_Xferred ) - Re_Xferred = Re_Xferred + 1 + OutData%DummyConstrState = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 END SUBROUTINE SD_UnPackConstrState SUBROUTINE SD_CopyOtherState( SrcOtherStateData, DstOtherStateData, CtrlCode, ErrStat, ErrMsg ) @@ -4809,8 +4750,8 @@ SUBROUTINE SD_PackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMs ENDIF END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%n - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%n + Int_Xferred = Int_Xferred + 1 END SUBROUTINE SD_PackOtherState SUBROUTINE SD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -4826,12 +4767,6 @@ SUBROUTINE SD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -4902,8 +4837,8 @@ SUBROUTINE SD_UnPackOtherState( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%n = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%n = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE SD_UnPackOtherState SUBROUTINE SD_CopyMisc( SrcMiscData, DstMiscData, CtrlCode, ErrStat, ErrMsg ) @@ -5196,15 +5131,23 @@ SUBROUTINE SD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%qmdotdot,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%qmdotdot)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%qmdotdot))-1 ) = PACK(InData%qmdotdot,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%qmdotdot) + DO i1 = LBOUND(InData%qmdotdot,1), UBOUND(InData%qmdotdot,1) + ReKiBuf(Re_Xferred) = InData%qmdotdot(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%u_TP))-1 ) = PACK(InData%u_TP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%u_TP) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%udot_TP))-1 ) = PACK(InData%udot_TP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%udot_TP) - ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%udotdot_TP))-1 ) = PACK(InData%udotdot_TP,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%udotdot_TP) + DO i1 = LBOUND(InData%u_TP,1), UBOUND(InData%u_TP,1) + ReKiBuf(Re_Xferred) = InData%u_TP(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%udot_TP,1), UBOUND(InData%udot_TP,1) + ReKiBuf(Re_Xferred) = InData%udot_TP(i1) + Re_Xferred = Re_Xferred + 1 + END DO + DO i1 = LBOUND(InData%udotdot_TP,1), UBOUND(InData%udotdot_TP,1) + ReKiBuf(Re_Xferred) = InData%udotdot_TP(i1) + Re_Xferred = Re_Xferred + 1 + END DO IF ( .NOT. ALLOCATED(InData%UFL) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -5215,8 +5158,10 @@ SUBROUTINE SD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UFL,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%UFL)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%UFL))-1 ) = PACK(InData%UFL,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%UFL) + DO i1 = LBOUND(InData%UFL,1), UBOUND(InData%UFL,1) + ReKiBuf(Re_Xferred) = InData%UFL(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%UR_bar) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5228,8 +5173,10 @@ SUBROUTINE SD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UR_bar,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%UR_bar)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%UR_bar))-1 ) = PACK(InData%UR_bar,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%UR_bar) + DO i1 = LBOUND(InData%UR_bar,1), UBOUND(InData%UR_bar,1) + ReKiBuf(Re_Xferred) = InData%UR_bar(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%UR_bar_dot) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5241,8 +5188,10 @@ SUBROUTINE SD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UR_bar_dot,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%UR_bar_dot)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%UR_bar_dot))-1 ) = PACK(InData%UR_bar_dot,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%UR_bar_dot) + DO i1 = LBOUND(InData%UR_bar_dot,1), UBOUND(InData%UR_bar_dot,1) + ReKiBuf(Re_Xferred) = InData%UR_bar_dot(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%UR_bar_dotdot) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5254,8 +5203,10 @@ SUBROUTINE SD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UR_bar_dotdot,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%UR_bar_dotdot)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%UR_bar_dotdot))-1 ) = PACK(InData%UR_bar_dotdot,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%UR_bar_dotdot) + DO i1 = LBOUND(InData%UR_bar_dotdot,1), UBOUND(InData%UR_bar_dotdot,1) + ReKiBuf(Re_Xferred) = InData%UR_bar_dotdot(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%UL) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5267,8 +5218,10 @@ SUBROUTINE SD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UL,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%UL)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%UL))-1 ) = PACK(InData%UL,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%UL) + DO i1 = LBOUND(InData%UL,1), UBOUND(InData%UL,1) + ReKiBuf(Re_Xferred) = InData%UL(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%UL_dot) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5280,8 +5233,10 @@ SUBROUTINE SD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UL_dot,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%UL_dot)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%UL_dot))-1 ) = PACK(InData%UL_dot,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%UL_dot) + DO i1 = LBOUND(InData%UL_dot,1), UBOUND(InData%UL_dot,1) + ReKiBuf(Re_Xferred) = InData%UL_dot(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%UL_dotdot) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5293,8 +5248,10 @@ SUBROUTINE SD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%UL_dotdot,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%UL_dotdot)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%UL_dotdot))-1 ) = PACK(InData%UL_dotdot,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%UL_dotdot) + DO i1 = LBOUND(InData%UL_dotdot,1), UBOUND(InData%UL_dotdot,1) + ReKiBuf(Re_Xferred) = InData%UL_dotdot(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%SDWrOutput) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -5306,13 +5263,15 @@ SUBROUTINE SD_PackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Siz IntKiBuf( Int_Xferred + 1) = UBOUND(InData%SDWrOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%SDWrOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%SDWrOutput))-1 ) = PACK(InData%SDWrOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%SDWrOutput) + DO i1 = LBOUND(InData%SDWrOutput,1), UBOUND(InData%SDWrOutput,1) + ReKiBuf(Re_Xferred) = InData%SDWrOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%LastOutTime - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Decimat - Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%LastOutTime + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Decimat + Int_Xferred = Int_Xferred + 1 END SUBROUTINE SD_PackMisc SUBROUTINE SD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -5328,12 +5287,6 @@ SUBROUTINE SD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -5361,49 +5314,29 @@ SUBROUTINE SD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%qmdotdot.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%qmdotdot)>0) OutData%qmdotdot = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%qmdotdot))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%qmdotdot) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%qmdotdot,1), UBOUND(OutData%qmdotdot,1) + OutData%qmdotdot(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF i1_l = LBOUND(OutData%u_TP,1) i1_u = UBOUND(OutData%u_TP,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%u_TP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%u_TP))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%u_TP) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%u_TP,1), UBOUND(OutData%u_TP,1) + OutData%u_TP(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%udot_TP,1) i1_u = UBOUND(OutData%udot_TP,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%udot_TP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%udot_TP))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%udot_TP) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%udot_TP,1), UBOUND(OutData%udot_TP,1) + OutData%udot_TP(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO i1_l = LBOUND(OutData%udotdot_TP,1) i1_u = UBOUND(OutData%udotdot_TP,1) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - OutData%udotdot_TP = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%udotdot_TP))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%udotdot_TP) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%udotdot_TP,1), UBOUND(OutData%udotdot_TP,1) + OutData%udotdot_TP(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UFL not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -5417,15 +5350,10 @@ SUBROUTINE SD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UFL.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%UFL)>0) OutData%UFL = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%UFL))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%UFL) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%UFL,1), UBOUND(OutData%UFL,1) + OutData%UFL(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UR_bar not allocated Int_Xferred = Int_Xferred + 1 @@ -5440,15 +5368,10 @@ SUBROUTINE SD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UR_bar.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%UR_bar)>0) OutData%UR_bar = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%UR_bar))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%UR_bar) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%UR_bar,1), UBOUND(OutData%UR_bar,1) + OutData%UR_bar(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UR_bar_dot not allocated Int_Xferred = Int_Xferred + 1 @@ -5463,15 +5386,10 @@ SUBROUTINE SD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UR_bar_dot.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%UR_bar_dot)>0) OutData%UR_bar_dot = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%UR_bar_dot))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%UR_bar_dot) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%UR_bar_dot,1), UBOUND(OutData%UR_bar_dot,1) + OutData%UR_bar_dot(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UR_bar_dotdot not allocated Int_Xferred = Int_Xferred + 1 @@ -5486,15 +5404,10 @@ SUBROUTINE SD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UR_bar_dotdot.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%UR_bar_dotdot)>0) OutData%UR_bar_dotdot = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%UR_bar_dotdot))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%UR_bar_dotdot) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%UR_bar_dotdot,1), UBOUND(OutData%UR_bar_dotdot,1) + OutData%UR_bar_dotdot(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UL not allocated Int_Xferred = Int_Xferred + 1 @@ -5509,15 +5422,10 @@ SUBROUTINE SD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UL.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%UL)>0) OutData%UL = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%UL))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%UL) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%UL,1), UBOUND(OutData%UL,1) + OutData%UL(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UL_dot not allocated Int_Xferred = Int_Xferred + 1 @@ -5532,15 +5440,10 @@ SUBROUTINE SD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UL_dot.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%UL_dot)>0) OutData%UL_dot = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%UL_dot))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%UL_dot) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%UL_dot,1), UBOUND(OutData%UL_dot,1) + OutData%UL_dot(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! UL_dotdot not allocated Int_Xferred = Int_Xferred + 1 @@ -5555,15 +5458,10 @@ SUBROUTINE SD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%UL_dotdot.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%UL_dotdot)>0) OutData%UL_dotdot = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%UL_dotdot))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%UL_dotdot) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%UL_dotdot,1), UBOUND(OutData%UL_dotdot,1) + OutData%UL_dotdot(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! SDWrOutput not allocated Int_Xferred = Int_Xferred + 1 @@ -5578,20 +5476,15 @@ SUBROUTINE SD_UnPackMisc( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%SDWrOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%SDWrOutput)>0) OutData%SDWrOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%SDWrOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%SDWrOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%SDWrOutput,1), UBOUND(OutData%SDWrOutput,1) + OutData%SDWrOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF - OutData%LastOutTime = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%Decimat = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%LastOutTime = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%Decimat = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE SD_UnPackMisc SUBROUTINE SD_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) @@ -6669,10 +6562,10 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Db_Xferred = 1 Int_Xferred = 1 - DbKiBuf ( Db_Xferred:Db_Xferred+(1)-1 ) = InData%SDDeltaT - Db_Xferred = Db_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%SttcSolve , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + DbKiBuf(Db_Xferred) = InData%SDDeltaT + Db_Xferred = Db_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%SttcSolve, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%NOmegaM2) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -6683,8 +6576,10 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%NOmegaM2,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%NOmegaM2)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%NOmegaM2))-1 ) = PACK(InData%NOmegaM2,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%NOmegaM2) + DO i1 = LBOUND(InData%NOmegaM2,1), UBOUND(InData%NOmegaM2,1) + ReKiBuf(Re_Xferred) = InData%NOmegaM2(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%N2OmegaMJDamp) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6696,8 +6591,10 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%N2OmegaMJDamp,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%N2OmegaMJDamp)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%N2OmegaMJDamp))-1 ) = PACK(InData%N2OmegaMJDamp,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%N2OmegaMJDamp) + DO i1 = LBOUND(InData%N2OmegaMJDamp,1), UBOUND(InData%N2OmegaMJDamp,1) + ReKiBuf(Re_Xferred) = InData%N2OmegaMJDamp(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%MMB) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6712,8 +6609,12 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MMB,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%MMB)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MMB))-1 ) = PACK(InData%MMB,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MMB) + DO i2 = LBOUND(InData%MMB,2), UBOUND(InData%MMB,2) + DO i1 = LBOUND(InData%MMB,1), UBOUND(InData%MMB,1) + ReKiBuf(Re_Xferred) = InData%MMB(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%FX) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6725,8 +6626,10 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FX,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FX)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FX))-1 ) = PACK(InData%FX,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FX) + DO i1 = LBOUND(InData%FX,1), UBOUND(InData%FX,1) + ReKiBuf(Re_Xferred) = InData%FX(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%C1_11) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6741,8 +6644,12 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C1_11,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%C1_11)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%C1_11))-1 ) = PACK(InData%C1_11,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%C1_11) + DO i2 = LBOUND(InData%C1_11,2), UBOUND(InData%C1_11,2) + DO i1 = LBOUND(InData%C1_11,1), UBOUND(InData%C1_11,1) + ReKiBuf(Re_Xferred) = InData%C1_11(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%C1_12) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6757,8 +6664,12 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C1_12,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%C1_12)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%C1_12))-1 ) = PACK(InData%C1_12,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%C1_12) + DO i2 = LBOUND(InData%C1_12,2), UBOUND(InData%C1_12,2) + DO i1 = LBOUND(InData%C1_12,1), UBOUND(InData%C1_12,1) + ReKiBuf(Re_Xferred) = InData%C1_12(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%D1_13) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6773,8 +6684,12 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D1_13,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D1_13)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D1_13))-1 ) = PACK(InData%D1_13,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D1_13) + 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) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%D1_14) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6789,8 +6704,12 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D1_14,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D1_14)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D1_14))-1 ) = PACK(InData%D1_14,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D1_14) + 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) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%FY) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6802,8 +6721,10 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FY,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FY)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FY))-1 ) = PACK(InData%FY,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FY) + 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 @@ -6818,8 +6739,12 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiM,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PhiM)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PhiM))-1 ) = PACK(InData%PhiM,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PhiM) + DO i2 = LBOUND(InData%PhiM,2), UBOUND(InData%PhiM,2) + DO i1 = LBOUND(InData%PhiM,1), UBOUND(InData%PhiM,1) + ReKiBuf(Re_Xferred) = InData%PhiM(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%C2_61) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6834,8 +6759,12 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C2_61,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%C2_61)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%C2_61))-1 ) = PACK(InData%C2_61,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%C2_61) + DO i2 = LBOUND(InData%C2_61,2), UBOUND(InData%C2_61,2) + DO i1 = LBOUND(InData%C2_61,1), UBOUND(InData%C2_61,1) + ReKiBuf(Re_Xferred) = InData%C2_61(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%C2_62) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6850,8 +6779,12 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%C2_62,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%C2_62)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%C2_62))-1 ) = PACK(InData%C2_62,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%C2_62) + DO i2 = LBOUND(InData%C2_62,2), UBOUND(InData%C2_62,2) + DO i1 = LBOUND(InData%C2_62,1), UBOUND(InData%C2_62,1) + ReKiBuf(Re_Xferred) = InData%C2_62(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PhiRb_TI) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6866,8 +6799,12 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiRb_TI,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PhiRb_TI)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PhiRb_TI))-1 ) = PACK(InData%PhiRb_TI,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PhiRb_TI) + DO i2 = LBOUND(InData%PhiRb_TI,2), UBOUND(InData%PhiRb_TI,2) + DO i1 = LBOUND(InData%PhiRb_TI,1), UBOUND(InData%PhiRb_TI,1) + ReKiBuf(Re_Xferred) = InData%PhiRb_TI(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%D2_63) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6882,8 +6819,12 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D2_63,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D2_63)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D2_63))-1 ) = PACK(InData%D2_63,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D2_63) + DO i2 = LBOUND(InData%D2_63,2), UBOUND(InData%D2_63,2) + DO i1 = LBOUND(InData%D2_63,1), UBOUND(InData%D2_63,1) + ReKiBuf(Re_Xferred) = InData%D2_63(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%D2_64) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6898,8 +6839,12 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%D2_64,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%D2_64)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%D2_64))-1 ) = PACK(InData%D2_64,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%D2_64) + DO i2 = LBOUND(InData%D2_64,2), UBOUND(InData%D2_64,2) + DO i1 = LBOUND(InData%D2_64,1), UBOUND(InData%D2_64,1) + ReKiBuf(Re_Xferred) = InData%D2_64(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%F2_61) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6911,8 +6856,10 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%F2_61,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%F2_61)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%F2_61))-1 ) = PACK(InData%F2_61,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%F2_61) + 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 @@ -6927,8 +6874,12 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MBB,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%MBB)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MBB))-1 ) = PACK(InData%MBB,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MBB) + DO i2 = LBOUND(InData%MBB,2), UBOUND(InData%MBB,2) + DO i1 = LBOUND(InData%MBB,1), UBOUND(InData%MBB,1) + ReKiBuf(Re_Xferred) = InData%MBB(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%KBB) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6943,8 +6894,12 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%KBB,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%KBB)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%KBB))-1 ) = PACK(InData%KBB,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%KBB) + DO i2 = LBOUND(InData%KBB,2), UBOUND(InData%KBB,2) + DO i1 = LBOUND(InData%KBB,1), UBOUND(InData%KBB,1) + ReKiBuf(Re_Xferred) = InData%KBB(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%MBM) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6959,8 +6914,12 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%MBM,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%MBM)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%MBM))-1 ) = PACK(InData%MBM,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%MBM) + DO i2 = LBOUND(InData%MBM,2), UBOUND(InData%MBM,2) + DO i1 = LBOUND(InData%MBM,1), UBOUND(InData%MBM,1) + ReKiBuf(Re_Xferred) = InData%MBM(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PhiL_T) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6975,8 +6934,12 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiL_T,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PhiL_T)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PhiL_T))-1 ) = PACK(InData%PhiL_T,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PhiL_T) + DO i2 = LBOUND(InData%PhiL_T,2), UBOUND(InData%PhiL_T,2) + DO i1 = LBOUND(InData%PhiL_T,1), UBOUND(InData%PhiL_T,1) + ReKiBuf(Re_Xferred) = InData%PhiL_T(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%PhiLInvOmgL2) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -6991,8 +6954,12 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%PhiLInvOmgL2,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%PhiLInvOmgL2)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%PhiLInvOmgL2))-1 ) = PACK(InData%PhiLInvOmgL2,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%PhiLInvOmgL2) + DO i2 = LBOUND(InData%PhiLInvOmgL2,2), UBOUND(InData%PhiLInvOmgL2,2) + DO i1 = LBOUND(InData%PhiLInvOmgL2,1), UBOUND(InData%PhiLInvOmgL2,1) + ReKiBuf(Re_Xferred) = InData%PhiLInvOmgL2(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%FGL) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7004,8 +6971,10 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%FGL,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%FGL)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%FGL))-1 ) = PACK(InData%FGL,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%FGL) + 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 IF ( .NOT. ALLOCATED(InData%AM2Jac) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7020,8 +6989,12 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AM2Jac,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AM2Jac)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%AM2Jac))-1 ) = PACK(InData%AM2Jac,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%AM2Jac) + DO i2 = LBOUND(InData%AM2Jac,2), UBOUND(InData%AM2Jac,2) + DO i1 = LBOUND(InData%AM2Jac,1), UBOUND(InData%AM2Jac,1) + ReKiBuf(Re_Xferred) = InData%AM2Jac(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%AM2JacPiv) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7033,8 +7006,10 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%AM2JacPiv,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%AM2JacPiv)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%AM2JacPiv))-1 ) = PACK(InData%AM2JacPiv,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%AM2JacPiv) + DO i1 = LBOUND(InData%AM2JacPiv,1), UBOUND(InData%AM2JacPiv,1) + IntKiBuf(Int_Xferred) = InData%AM2JacPiv(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%TI) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7049,8 +7024,12 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TI,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TI)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TI))-1 ) = PACK(InData%TI,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TI) + DO i2 = LBOUND(InData%TI,2), UBOUND(InData%TI,2) + DO i1 = LBOUND(InData%TI,1), UBOUND(InData%TI,1) + ReKiBuf(Re_Xferred) = InData%TI(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( .NOT. ALLOCATED(InData%TIreact) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7065,11 +7044,15 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%TIreact,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%TIreact)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%TIreact))-1 ) = PACK(InData%TIreact,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%TIreact) + DO i2 = LBOUND(InData%TIreact,2), UBOUND(InData%TIreact,2) + DO i1 = LBOUND(InData%TIreact,1), UBOUND(InData%TIreact,1) + ReKiBuf(Re_Xferred) = InData%TIreact(i1,i2) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NModes - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NModes + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%Elems) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -7083,27 +7066,31 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Elems,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Elems)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%Elems))-1 ) = PACK(InData%Elems,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%Elems) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%qmL - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DofL - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NNodes_I - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NNodes_L - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NNodes_RbarL - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DofI - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DofR - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%DofC - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NReact - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(InData%Elems,2), UBOUND(InData%Elems,2) + DO i1 = LBOUND(InData%Elems,1), UBOUND(InData%Elems,1) + IntKiBuf(Int_Xferred) = InData%Elems(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + IntKiBuf(Int_Xferred) = InData%qmL + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DofL + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NNodes_I + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NNodes_L + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NNodes_RbarL + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DofI + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DofR + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%DofC + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NReact + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%Reacts) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -7117,17 +7104,21 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%Reacts,2) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%Reacts)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%Reacts))-1 ) = PACK(InData%Reacts,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%Reacts) + DO i2 = LBOUND(InData%Reacts,2), UBOUND(InData%Reacts,2) + DO i1 = LBOUND(InData%Reacts,1), UBOUND(InData%Reacts,1) + IntKiBuf(Int_Xferred) = InData%Reacts(i1,i2) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%Nmembers - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%URbarL - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%IntMethod - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NAvgEls - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%Nmembers + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%URbarL + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%IntMethod + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NAvgEls + Int_Xferred = Int_Xferred + 1 IF ( .NOT. ALLOCATED(InData%IDI) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -7138,8 +7129,10 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IDI,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%IDI)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%IDI))-1 ) = PACK(InData%IDI,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%IDI) + DO i1 = LBOUND(InData%IDI,1), UBOUND(InData%IDI,1) + IntKiBuf(Int_Xferred) = InData%IDI(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%IDR) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7151,8 +7144,10 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IDR,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%IDR)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%IDR))-1 ) = PACK(InData%IDR,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%IDR) + DO i1 = LBOUND(InData%IDR,1), UBOUND(InData%IDR,1) + IntKiBuf(Int_Xferred) = InData%IDR(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%IDL) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7164,8 +7159,10 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IDL,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%IDL)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%IDL))-1 ) = PACK(InData%IDL,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%IDL) + DO i1 = LBOUND(InData%IDL,1), UBOUND(InData%IDL,1) + IntKiBuf(Int_Xferred) = InData%IDL(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%IDC) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7177,8 +7174,10 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IDC,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%IDC)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%IDC))-1 ) = PACK(InData%IDC,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%IDC) + DO i1 = LBOUND(InData%IDC,1), UBOUND(InData%IDC,1) + IntKiBuf(Int_Xferred) = InData%IDC(i1) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( .NOT. ALLOCATED(InData%IDY) ) THEN IntKiBuf( Int_Xferred ) = 0 @@ -7190,29 +7189,31 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%IDY,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%IDY)>0) IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(InData%IDY))-1 ) = PACK(InData%IDY,.TRUE.) - Int_Xferred = Int_Xferred + SIZE(InData%IDY) - END IF - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NMOutputs - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumOuts - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%OutSwtch - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%UnJckF - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(InData%Delim) - IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%OutFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(InData%OutSFmt) - IntKiBuf(Int_Xferred) = ICHAR(InData%OutSFmt(I:I), IntKi) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO i1 = LBOUND(InData%IDY,1), UBOUND(InData%IDY,1) + IntKiBuf(Int_Xferred) = InData%IDY(i1) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + IntKiBuf(Int_Xferred) = InData%NMOutputs + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumOuts + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%OutSwtch + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%UnJckF + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(InData%Delim) + IntKiBuf(Int_Xferred) = ICHAR(InData%Delim(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%OutFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(InData%OutSFmt) + IntKiBuf(Int_Xferred) = ICHAR(InData%OutSFmt(I:I), IntKi) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( .NOT. ALLOCATED(InData%MoutLst) ) THEN IntKiBuf( Int_Xferred ) = 0 Int_Xferred = Int_Xferred + 1 @@ -7418,16 +7419,16 @@ SUBROUTINE SD_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si ENDIF END DO END IF - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%OutAll , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%OutReact , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%OutAllInt - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%OutAllDims - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%OutDec - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%OutAll, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%OutReact, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%OutAllInt + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%OutAllDims + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%OutDec + Int_Xferred = Int_Xferred + 1 END SUBROUTINE SD_PackParam SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -7443,12 +7444,6 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: i2, i2_l, i2_u ! bounds (upper/lower) for an array dimension 2 INTEGER(IntKi) :: ErrStat2 @@ -7464,10 +7459,10 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%SDDeltaT = DbKiBuf( Db_Xferred ) - Db_Xferred = Db_Xferred + 1 - OutData%SttcSolve = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%SDDeltaT = DbKiBuf(Db_Xferred) + Db_Xferred = Db_Xferred + 1 + OutData%SttcSolve = TRANSFER(IntKiBuf(Int_Xferred), OutData%SttcSolve) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! NOmegaM2 not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -7481,15 +7476,10 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%NOmegaM2.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%NOmegaM2)>0) OutData%NOmegaM2 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%NOmegaM2))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%NOmegaM2) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%NOmegaM2,1), UBOUND(OutData%NOmegaM2,1) + OutData%NOmegaM2(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! N2OmegaMJDamp not allocated Int_Xferred = Int_Xferred + 1 @@ -7504,15 +7494,10 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%N2OmegaMJDamp.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%N2OmegaMJDamp)>0) OutData%N2OmegaMJDamp = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%N2OmegaMJDamp))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%N2OmegaMJDamp) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%N2OmegaMJDamp,1), UBOUND(OutData%N2OmegaMJDamp,1) + OutData%N2OmegaMJDamp(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MMB not allocated Int_Xferred = Int_Xferred + 1 @@ -7530,15 +7515,12 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MMB.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%MMB)>0) OutData%MMB = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MMB))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%MMB) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%MMB,2), UBOUND(OutData%MMB,2) + DO i1 = LBOUND(OutData%MMB,1), UBOUND(OutData%MMB,1) + OutData%MMB(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FX not allocated Int_Xferred = Int_Xferred + 1 @@ -7553,15 +7535,10 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FX.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%FX)>0) OutData%FX = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FX))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FX) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%FX,1), UBOUND(OutData%FX,1) + OutData%FX(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C1_11 not allocated Int_Xferred = Int_Xferred + 1 @@ -7579,15 +7556,12 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C1_11.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%C1_11)>0) OutData%C1_11 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%C1_11))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%C1_11) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%C1_11,2), UBOUND(OutData%C1_11,2) + DO i1 = LBOUND(OutData%C1_11,1), UBOUND(OutData%C1_11,1) + OutData%C1_11(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C1_12 not allocated Int_Xferred = Int_Xferred + 1 @@ -7605,15 +7579,12 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C1_12.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%C1_12)>0) OutData%C1_12 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%C1_12))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%C1_12) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%C1_12,2), UBOUND(OutData%C1_12,2) + DO i1 = LBOUND(OutData%C1_12,1), UBOUND(OutData%C1_12,1) + OutData%C1_12(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D1_13 not allocated Int_Xferred = Int_Xferred + 1 @@ -7631,15 +7602,12 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D1_13.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%D1_13)>0) OutData%D1_13 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D1_13))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D1_13) - DEALLOCATE(mask2) + 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) + 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 @@ -7657,15 +7625,12 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D1_14.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%D1_14)>0) OutData%D1_14 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D1_14))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D1_14) - DEALLOCATE(mask2) + 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 @@ -7680,15 +7645,10 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FY.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%FY)>0) OutData%FY = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FY))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FY) - DEALLOCATE(mask1) + 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 @@ -7706,15 +7666,12 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiM.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PhiM)>0) OutData%PhiM = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PhiM))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PhiM) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PhiM,2), UBOUND(OutData%PhiM,2) + DO i1 = LBOUND(OutData%PhiM,1), UBOUND(OutData%PhiM,1) + OutData%PhiM(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C2_61 not allocated Int_Xferred = Int_Xferred + 1 @@ -7732,15 +7689,12 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C2_61.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%C2_61)>0) OutData%C2_61 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%C2_61))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%C2_61) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%C2_61,2), UBOUND(OutData%C2_61,2) + DO i1 = LBOUND(OutData%C2_61,1), UBOUND(OutData%C2_61,1) + OutData%C2_61(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! C2_62 not allocated Int_Xferred = Int_Xferred + 1 @@ -7758,15 +7712,12 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%C2_62.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%C2_62)>0) OutData%C2_62 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%C2_62))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%C2_62) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%C2_62,2), UBOUND(OutData%C2_62,2) + DO i1 = LBOUND(OutData%C2_62,1), UBOUND(OutData%C2_62,1) + OutData%C2_62(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PhiRb_TI not allocated Int_Xferred = Int_Xferred + 1 @@ -7784,15 +7735,12 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiRb_TI.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PhiRb_TI)>0) OutData%PhiRb_TI = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PhiRb_TI))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PhiRb_TI) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PhiRb_TI,2), UBOUND(OutData%PhiRb_TI,2) + DO i1 = LBOUND(OutData%PhiRb_TI,1), UBOUND(OutData%PhiRb_TI,1) + OutData%PhiRb_TI(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D2_63 not allocated Int_Xferred = Int_Xferred + 1 @@ -7810,15 +7758,12 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D2_63.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%D2_63)>0) OutData%D2_63 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D2_63))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D2_63) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%D2_63,2), UBOUND(OutData%D2_63,2) + DO i1 = LBOUND(OutData%D2_63,1), UBOUND(OutData%D2_63,1) + OutData%D2_63(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! D2_64 not allocated Int_Xferred = Int_Xferred + 1 @@ -7836,15 +7781,12 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%D2_64.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%D2_64)>0) OutData%D2_64 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%D2_64))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%D2_64) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%D2_64,2), UBOUND(OutData%D2_64,2) + DO i1 = LBOUND(OutData%D2_64,1), UBOUND(OutData%D2_64,1) + OutData%D2_64(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! F2_61 not allocated Int_Xferred = Int_Xferred + 1 @@ -7859,15 +7801,10 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%F2_61.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%F2_61)>0) OutData%F2_61 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%F2_61))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%F2_61) - DEALLOCATE(mask1) + 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 @@ -7885,15 +7822,12 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MBB.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%MBB)>0) OutData%MBB = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MBB))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%MBB) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%MBB,2), UBOUND(OutData%MBB,2) + DO i1 = LBOUND(OutData%MBB,1), UBOUND(OutData%MBB,1) + OutData%MBB(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! KBB not allocated Int_Xferred = Int_Xferred + 1 @@ -7911,15 +7845,12 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%KBB.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%KBB)>0) OutData%KBB = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%KBB))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%KBB) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%KBB,2), UBOUND(OutData%KBB,2) + DO i1 = LBOUND(OutData%KBB,1), UBOUND(OutData%KBB,1) + OutData%KBB(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MBM not allocated Int_Xferred = Int_Xferred + 1 @@ -7937,15 +7868,12 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%MBM.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%MBM)>0) OutData%MBM = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%MBM))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%MBM) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%MBM,2), UBOUND(OutData%MBM,2) + DO i1 = LBOUND(OutData%MBM,1), UBOUND(OutData%MBM,1) + OutData%MBM(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PhiL_T not allocated Int_Xferred = Int_Xferred + 1 @@ -7963,15 +7891,12 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiL_T.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PhiL_T)>0) OutData%PhiL_T = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PhiL_T))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PhiL_T) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PhiL_T,2), UBOUND(OutData%PhiL_T,2) + DO i1 = LBOUND(OutData%PhiL_T,1), UBOUND(OutData%PhiL_T,1) + OutData%PhiL_T(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! PhiLInvOmgL2 not allocated Int_Xferred = Int_Xferred + 1 @@ -7989,15 +7914,12 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%PhiLInvOmgL2.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%PhiLInvOmgL2)>0) OutData%PhiLInvOmgL2 = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%PhiLInvOmgL2))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%PhiLInvOmgL2) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%PhiLInvOmgL2,2), UBOUND(OutData%PhiLInvOmgL2,2) + DO i1 = LBOUND(OutData%PhiLInvOmgL2,1), UBOUND(OutData%PhiLInvOmgL2,1) + OutData%PhiLInvOmgL2(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! FGL not allocated Int_Xferred = Int_Xferred + 1 @@ -8012,15 +7934,10 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%FGL.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%FGL)>0) OutData%FGL = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%FGL))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%FGL) - DEALLOCATE(mask1) + 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 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AM2Jac not allocated Int_Xferred = Int_Xferred + 1 @@ -8038,15 +7955,12 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AM2Jac.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%AM2Jac)>0) OutData%AM2Jac = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%AM2Jac))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%AM2Jac) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%AM2Jac,2), UBOUND(OutData%AM2Jac,2) + DO i1 = LBOUND(OutData%AM2Jac,1), UBOUND(OutData%AM2Jac,1) + OutData%AM2Jac(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! AM2JacPiv not allocated Int_Xferred = Int_Xferred + 1 @@ -8061,15 +7975,10 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%AM2JacPiv.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%AM2JacPiv)>0) OutData%AM2JacPiv = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%AM2JacPiv))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%AM2JacPiv) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%AM2JacPiv,1), UBOUND(OutData%AM2JacPiv,1) + OutData%AM2JacPiv(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TI not allocated Int_Xferred = Int_Xferred + 1 @@ -8087,15 +7996,12 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TI.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%TI)>0) OutData%TI = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TI))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TI) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%TI,2), UBOUND(OutData%TI,2) + DO i1 = LBOUND(OutData%TI,1), UBOUND(OutData%TI,1) + OutData%TI(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! TIreact not allocated Int_Xferred = Int_Xferred + 1 @@ -8113,18 +8019,15 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%TIreact.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%TIreact)>0) OutData%TIreact = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%TIreact))-1 ), mask2, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%TIreact) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%TIreact,2), UBOUND(OutData%TIreact,2) + DO i1 = LBOUND(OutData%TIreact,1), UBOUND(OutData%TIreact,1) + OutData%TIreact(i1,i2) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO + END DO END IF - OutData%NModes = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NModes = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Elems not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -8141,34 +8044,31 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Elems.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Elems)>0) OutData%Elems = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%Elems))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%Elems) - DEALLOCATE(mask2) - END IF - OutData%qmL = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%DofL = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NNodes_I = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NNodes_L = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NNodes_RbarL = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%DofI = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%DofR = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%DofC = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NReact = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + DO i2 = LBOUND(OutData%Elems,2), UBOUND(OutData%Elems,2) + DO i1 = LBOUND(OutData%Elems,1), UBOUND(OutData%Elems,1) + OutData%Elems(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO + END IF + OutData%qmL = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%DofL = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NNodes_I = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NNodes_L = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NNodes_RbarL = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%DofI = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%DofR = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%DofC = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NReact = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! Reacts not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -8185,24 +8085,21 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%Reacts.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask2(i1_l:i1_u,i2_l:i2_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask2.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask2 = .TRUE. - IF (SIZE(OutData%Reacts)>0) OutData%Reacts = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%Reacts))-1 ), mask2, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%Reacts) - DEALLOCATE(mask2) + DO i2 = LBOUND(OutData%Reacts,2), UBOUND(OutData%Reacts,2) + DO i1 = LBOUND(OutData%Reacts,1), UBOUND(OutData%Reacts,1) + OutData%Reacts(i1,i2) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END DO END IF - OutData%Nmembers = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%URbarL = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%IntMethod = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NAvgEls = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%Nmembers = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%URbarL = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%IntMethod = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NAvgEls = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IDI not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -8216,15 +8113,10 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDI.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%IDI)>0) OutData%IDI = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%IDI))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%IDI) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%IDI,1), UBOUND(OutData%IDI,1) + OutData%IDI(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IDR not allocated Int_Xferred = Int_Xferred + 1 @@ -8239,15 +8131,10 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDR.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%IDR)>0) OutData%IDR = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%IDR))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%IDR) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%IDR,1), UBOUND(OutData%IDR,1) + OutData%IDR(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IDL not allocated Int_Xferred = Int_Xferred + 1 @@ -8262,15 +8149,10 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDL.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%IDL)>0) OutData%IDL = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%IDL))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%IDL) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%IDL,1), UBOUND(OutData%IDL,1) + OutData%IDL(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IDC not allocated Int_Xferred = Int_Xferred + 1 @@ -8285,15 +8167,10 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDC.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%IDC)>0) OutData%IDC = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%IDC))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%IDC) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%IDC,1), UBOUND(OutData%IDC,1) + OutData%IDC(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO END IF IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! IDY not allocated Int_Xferred = Int_Xferred + 1 @@ -8308,36 +8185,31 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%IDY.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%IDY)>0) OutData%IDY = UNPACK( IntKiBuf ( Int_Xferred:Int_Xferred+(SIZE(OutData%IDY))-1 ), mask1, 0_IntKi ) - Int_Xferred = Int_Xferred + SIZE(OutData%IDY) - DEALLOCATE(mask1) - END IF - OutData%NMOutputs = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%NumOuts = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%OutSwtch = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%UnJckF = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - DO I = 1, LEN(OutData%Delim) - OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%OutFmt) - OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I - DO I = 1, LEN(OutData%OutSFmt) - OutData%OutSFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) - Int_Xferred = Int_Xferred + 1 - END DO ! I + DO i1 = LBOUND(OutData%IDY,1), UBOUND(OutData%IDY,1) + OutData%IDY(i1) = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + END DO + END IF + OutData%NMOutputs = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%NumOuts = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%OutSwtch = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%UnJckF = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + DO I = 1, LEN(OutData%Delim) + OutData%Delim(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%OutFmt) + OutData%OutFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I + DO I = 1, LEN(OutData%OutSFmt) + OutData%OutSFmt(I:I) = CHAR(IntKiBuf(Int_Xferred)) + Int_Xferred = Int_Xferred + 1 + END DO ! I IF ( IntKiBuf( Int_Xferred ) == 0 ) THEN ! MoutLst not allocated Int_Xferred = Int_Xferred + 1 ELSE @@ -8618,16 +8490,16 @@ SUBROUTINE SD_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END DO END IF - OutData%OutAll = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%OutReact = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 - OutData%OutAllInt = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%OutAllDims = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 - OutData%OutDec = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%OutAll = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutAll) + Int_Xferred = Int_Xferred + 1 + OutData%OutReact = TRANSFER(IntKiBuf(Int_Xferred), OutData%OutReact) + Int_Xferred = Int_Xferred + 1 + OutData%OutAllInt = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%OutAllDims = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 + OutData%OutDec = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE SD_UnPackParam SUBROUTINE SD_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) @@ -8833,12 +8705,6 @@ SUBROUTINE SD_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SD_UnPackInput' @@ -9153,8 +9019,10 @@ SUBROUTINE SD_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%WriteOutput,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%WriteOutput)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%WriteOutput))-1 ) = PACK(InData%WriteOutput,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%WriteOutput) + DO i1 = LBOUND(InData%WriteOutput,1), UBOUND(InData%WriteOutput,1) + ReKiBuf(Re_Xferred) = InData%WriteOutput(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE SD_PackOutput @@ -9171,12 +9039,6 @@ SUBROUTINE SD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -9284,15 +9146,10 @@ SUBROUTINE SD_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 'Error allocating OutData%WriteOutput.', ErrStat, ErrMsg,RoutineName) RETURN END IF - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%WriteOutput)>0) OutData%WriteOutput = UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%WriteOutput))-1 ), mask1, 0.0_ReKi ) - Re_Xferred = Re_Xferred + SIZE(OutData%WriteOutput) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%WriteOutput,1), UBOUND(OutData%WriteOutput,1) + OutData%WriteOutput(i1) = ReKiBuf(Re_Xferred) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE SD_UnPackOutput @@ -9371,8 +9228,8 @@ SUBROUTINE SD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'SD_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors ! Initialize ErrStat @@ -9387,6 +9244,8 @@ SUBROUTINE SD_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(u1%TPMesh, u2%TPMesh, tin, u_out%TPMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL MeshExtrapInterp1(u1%LMesh, u2%LMesh, tin, u_out%LMesh, tin_out, ErrStat2, ErrMsg2 ) @@ -9420,8 +9279,9 @@ SUBROUTINE SD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'SD_Input_ExtrapInterp2' @@ -9443,6 +9303,8 @@ SUBROUTINE SD_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(u1%TPMesh, u2%TPMesh, u3%TPMesh, tin, u_out%TPMesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL MeshExtrapInterp2(u1%LMesh, u2%LMesh, u3%LMesh, tin, u_out%LMesh, tin_out, ErrStat2, ErrMsg2 ) @@ -9524,12 +9386,12 @@ SUBROUTINE SD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'SD_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -9542,17 +9404,17 @@ SUBROUTINE SD_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) CALL MeshExtrapInterp1(y1%Y1Mesh, y2%Y1Mesh, tin, y_out%Y1Mesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL MeshExtrapInterp1(y1%Y2Mesh, y2%Y2Mesh, tin, y_out%Y2Mesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = -(y1%WriteOutput - y2%WriteOutput)/t(2) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = -(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b * ScaleFactor + END DO END IF ! check if allocated END SUBROUTINE SD_Output_ExtrapInterp1 @@ -9583,13 +9445,14 @@ SUBROUTINE SD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'SD_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -9608,18 +9471,18 @@ SUBROUTINE SD_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) CALL MeshExtrapInterp2(y1%Y1Mesh, y2%Y1Mesh, y3%Y1Mesh, tin, y_out%Y1Mesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) CALL MeshExtrapInterp2(y1%Y2Mesh, y2%Y2Mesh, y3%Y2Mesh, tin, y_out%Y2Mesh, tin_out, ErrStat2, ErrMsg2 ) CALL SetErrStat(ErrStat2, ErrMsg2, ErrStat, ErrMsg,RoutineName) IF (ALLOCATED(y_out%WriteOutput) .AND. ALLOCATED(y1%WriteOutput)) THEN - ALLOCATE(b1(SIZE(y_out%WriteOutput,1))) - ALLOCATE(c1(SIZE(y_out%WriteOutput,1))) - b1 = (t(3)**2*(y1%WriteOutput - y2%WriteOutput) + t(2)**2*(-y1%WriteOutput + y3%WriteOutput))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%WriteOutput + t(3)*y2%WriteOutput - t(2)*y3%WriteOutput ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%WriteOutput = y1%WriteOutput + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%WriteOutput,1),UBOUND(y_out%WriteOutput,1) + b = (t(3)**2*(y1%WriteOutput(i1) - y2%WriteOutput(i1)) + t(2)**2*(-y1%WriteOutput(i1) + y3%WriteOutput(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%WriteOutput(i1) + t(3)*y2%WriteOutput(i1) - t(2)*y3%WriteOutput(i1) ) * scaleFactor + y_out%WriteOutput(i1) = y1%WriteOutput(i1) + b + c * t_out + END DO END IF ! check if allocated END SUBROUTINE SD_Output_ExtrapInterp2 diff --git a/modules/supercontroller/src/SuperController_Types.f90 b/modules/supercontroller/src/SuperController_Types.f90 index 22edf3d7e7..0f3078661c 100644 --- a/modules/supercontroller/src/SuperController_Types.f90 +++ b/modules/supercontroller/src/SuperController_Types.f90 @@ -186,10 +186,10 @@ SUBROUTINE SC_PackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumSC2Ctrl - Int_Xferred = Int_Xferred + 1 - IntKiBuf ( Int_Xferred:Int_Xferred+(1)-1 ) = InData%NumCtrl2SC - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumSC2Ctrl + Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = InData%NumCtrl2SC + Int_Xferred = Int_Xferred + 1 END SUBROUTINE SC_PackInitInput SUBROUTINE SC_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -205,12 +205,6 @@ SUBROUTINE SC_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -225,25 +219,52 @@ SUBROUTINE SC_UnPackInitInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Err Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%NumSC2Ctrl = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NumSC2Ctrl = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 OutData%C_obj%NumSC2Ctrl = OutData%NumSC2Ctrl - OutData%NumCtrl2SC = IntKiBuf( Int_Xferred ) - Int_Xferred = Int_Xferred + 1 + OutData%NumCtrl2SC = IntKiBuf(Int_Xferred) + Int_Xferred = Int_Xferred + 1 OutData%C_obj%NumCtrl2SC = OutData%NumCtrl2SC END SUBROUTINE SC_UnPackInitInput - SUBROUTINE SC_C2Fary_CopyInitInput( InitInputData, ErrStat, ErrMsg ) + SUBROUTINE SC_C2Fary_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers ) TYPE(SC_InitInputType), INTENT(INOUT) :: InitInputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF InitInputData%NumSC2Ctrl = InitInputData%C_obj%NumSC2Ctrl InitInputData%NumCtrl2SC = InitInputData%C_obj%NumCtrl2SC END SUBROUTINE SC_C2Fary_CopyInitInput + SUBROUTINE SC_F2C_CopyInitInput( InitInputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(SC_InitInputType), INTENT(INOUT) :: InitInputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + InitInputData%C_obj%NumSC2Ctrl = InitInputData%NumSC2Ctrl + InitInputData%C_obj%NumCtrl2SC = InitInputData%NumCtrl2SC + END SUBROUTINE SC_F2C_CopyInitInput + SUBROUTINE SC_CopyInitOutput( SrcInitOutputData, DstInitOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(SC_InitOutputType), INTENT(IN) :: SrcInitOutputData TYPE(SC_InitOutputType), INTENT(INOUT) :: DstInitOutputData @@ -400,12 +421,6 @@ SUBROUTINE SC_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SC_UnPackInitOutput' @@ -461,15 +476,40 @@ SUBROUTINE SC_UnPackInitOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, Er IF(ALLOCATED(Int_Buf)) DEALLOCATE(Int_Buf) END SUBROUTINE SC_UnPackInitOutput - SUBROUTINE SC_C2Fary_CopyInitOutput( InitOutputData, ErrStat, ErrMsg ) + SUBROUTINE SC_C2Fary_CopyInitOutput( InitOutputData, ErrStat, ErrMsg, SkipPointers ) TYPE(SC_InitOutputType), INTENT(INOUT) :: InitOutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF END SUBROUTINE SC_C2Fary_CopyInitOutput + SUBROUTINE SC_F2C_CopyInitOutput( InitOutputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(SC_InitOutputType), INTENT(INOUT) :: InitOutputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + END SUBROUTINE SC_F2C_CopyInitOutput + SUBROUTINE SC_CopyParam( SrcParamData, DstParamData, CtrlCode, ErrStat, ErrMsg ) TYPE(SC_ParameterType), INTENT(IN) :: SrcParamData TYPE(SC_ParameterType), INTENT(INOUT) :: DstParamData @@ -564,8 +604,8 @@ SUBROUTINE SC_PackParam( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si Db_Xferred = 1 Int_Xferred = 1 - IntKiBuf ( Int_Xferred:Int_Xferred+1-1 ) = TRANSFER( InData%scOn , IntKiBuf(1), 1) - Int_Xferred = Int_Xferred + 1 + IntKiBuf(Int_Xferred) = TRANSFER(InData%scOn, IntKiBuf(1)) + Int_Xferred = Int_Xferred + 1 END SUBROUTINE SC_PackParam SUBROUTINE SC_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg ) @@ -581,12 +621,6 @@ SUBROUTINE SC_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 CHARACTER(*), PARAMETER :: RoutineName = 'SC_UnPackParam' @@ -600,21 +634,47 @@ SUBROUTINE SC_UnPackParam( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg Re_Xferred = 1 Db_Xferred = 1 Int_Xferred = 1 - OutData%scOn = TRANSFER( IntKiBuf( Int_Xferred ), mask0 ) - Int_Xferred = Int_Xferred + 1 + OutData%scOn = TRANSFER(IntKiBuf(Int_Xferred), OutData%scOn) + Int_Xferred = Int_Xferred + 1 OutData%C_obj%scOn = OutData%scOn END SUBROUTINE SC_UnPackParam - SUBROUTINE SC_C2Fary_CopyParam( ParamData, ErrStat, ErrMsg ) + SUBROUTINE SC_C2Fary_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) TYPE(SC_ParameterType), INTENT(INOUT) :: ParamData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF ParamData%scOn = ParamData%C_obj%scOn END SUBROUTINE SC_C2Fary_CopyParam + SUBROUTINE SC_F2C_CopyParam( ParamData, ErrStat, ErrMsg, SkipPointers ) + TYPE(SC_ParameterType), INTENT(INOUT) :: ParamData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + ParamData%C_obj%scOn = ParamData%scOn + END SUBROUTINE SC_F2C_CopyParam + SUBROUTINE SC_CopyInput( SrcInputData, DstInputData, CtrlCode, ErrStat, ErrMsg ) TYPE(SC_InputType), INTENT(IN) :: SrcInputData TYPE(SC_InputType), INTENT(INOUT) :: DstInputData @@ -743,8 +803,10 @@ SUBROUTINE SC_PackInput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, Si IntKiBuf( Int_Xferred + 1) = UBOUND(InData%toSC,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%toSC)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%toSC))-1 ) = PACK(InData%toSC,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%toSC) + DO i1 = LBOUND(InData%toSC,1), UBOUND(InData%toSC,1) + ReKiBuf(Re_Xferred) = InData%toSC(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE SC_PackInput @@ -761,12 +823,6 @@ SUBROUTINE SC_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -797,34 +853,68 @@ SUBROUTINE SC_UnPackInput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg OutData%c_obj%toSC_Len = SIZE(OutData%toSC) IF (OutData%c_obj%toSC_Len > 0) & OutData%c_obj%toSC = C_LOC( OutData%toSC(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%toSC)>0) OutData%toSC = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%toSC))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%toSC) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%toSC,1), UBOUND(OutData%toSC,1) + OutData%toSC(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE SC_UnPackInput - SUBROUTINE SC_C2Fary_CopyInput( InputData, ErrStat, ErrMsg ) + SUBROUTINE SC_C2Fary_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) TYPE(SC_InputType), INTENT(INOUT) :: InputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" - ! -- toSC Input Data fields - IF ( .NOT. C_ASSOCIATED( InputData%C_obj%toSC ) ) THEN - NULLIFY( InputData%toSC ) + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers ELSE - CALL C_F_POINTER(InputData%C_obj%toSC, InputData%toSC, (/InputData%C_obj%toSC_Len/)) + SkipPointers_local = .false. + END IF + + ! -- toSC Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( InputData%C_obj%toSC ) ) THEN + NULLIFY( InputData%toSC ) + ELSE + CALL C_F_POINTER(InputData%C_obj%toSC, InputData%toSC, (/InputData%C_obj%toSC_Len/)) + END IF END IF END SUBROUTINE SC_C2Fary_CopyInput + SUBROUTINE SC_F2C_CopyInput( InputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(SC_InputType), INTENT(INOUT) :: InputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + + ! -- toSC Input Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(InputData%toSC)) THEN + InputData%c_obj%toSC_Len = 0 + InputData%c_obj%toSC = C_NULL_PTR + ELSE + InputData%c_obj%toSC_Len = SIZE(InputData%toSC) + IF (InputData%c_obj%toSC_Len > 0) & + InputData%c_obj%toSC = C_LOC( InputData%toSC( LBOUND(InputData%toSC,1) ) ) + END IF + END IF + END SUBROUTINE SC_F2C_CopyInput + SUBROUTINE SC_CopyOutput( SrcOutputData, DstOutputData, CtrlCode, ErrStat, ErrMsg ) TYPE(SC_OutputType), INTENT(IN) :: SrcOutputData TYPE(SC_OutputType), INTENT(INOUT) :: DstOutputData @@ -953,8 +1043,10 @@ SUBROUTINE SC_PackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Indata, ErrStat, ErrMsg, S IntKiBuf( Int_Xferred + 1) = UBOUND(InData%fromSC,1) Int_Xferred = Int_Xferred + 2 - IF (SIZE(InData%fromSC)>0) ReKiBuf ( Re_Xferred:Re_Xferred+(SIZE(InData%fromSC))-1 ) = PACK(InData%fromSC,.TRUE.) - Re_Xferred = Re_Xferred + SIZE(InData%fromSC) + DO i1 = LBOUND(InData%fromSC,1), UBOUND(InData%fromSC,1) + ReKiBuf(Re_Xferred) = InData%fromSC(i1) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE SC_PackOutput @@ -971,12 +1063,6 @@ SUBROUTINE SC_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg INTEGER(IntKi) :: Db_Xferred INTEGER(IntKi) :: Int_Xferred INTEGER(IntKi) :: i - LOGICAL :: mask0 - LOGICAL, ALLOCATABLE :: mask1(:) - LOGICAL, ALLOCATABLE :: mask2(:,:) - LOGICAL, ALLOCATABLE :: mask3(:,:,:) - LOGICAL, ALLOCATABLE :: mask4(:,:,:,:) - LOGICAL, ALLOCATABLE :: mask5(:,:,:,:,:) INTEGER(IntKi) :: i1, i1_l, i1_u ! bounds (upper/lower) for an array dimension 1 INTEGER(IntKi) :: ErrStat2 CHARACTER(ErrMsgLen) :: ErrMsg2 @@ -1007,34 +1093,68 @@ SUBROUTINE SC_UnPackOutput( ReKiBuf, DbKiBuf, IntKiBuf, Outdata, ErrStat, ErrMsg OutData%c_obj%fromSC_Len = SIZE(OutData%fromSC) IF (OutData%c_obj%fromSC_Len > 0) & OutData%c_obj%fromSC = C_LOC( OutData%fromSC(i1_l) ) - ALLOCATE(mask1(i1_l:i1_u),STAT=ErrStat2) - IF (ErrStat2 /= 0) THEN - CALL SetErrStat(ErrID_Fatal, 'Error allocating mask1.', ErrStat, ErrMsg,RoutineName) - RETURN - END IF - mask1 = .TRUE. - IF (SIZE(OutData%fromSC)>0) OutData%fromSC = REAL( UNPACK(ReKiBuf( Re_Xferred:Re_Xferred+(SIZE(OutData%fromSC))-1 ), mask1, 0.0_ReKi ), C_FLOAT) - Re_Xferred = Re_Xferred + SIZE(OutData%fromSC) - DEALLOCATE(mask1) + DO i1 = LBOUND(OutData%fromSC,1), UBOUND(OutData%fromSC,1) + OutData%fromSC(i1) = REAL(ReKiBuf(Re_Xferred), C_FLOAT) + Re_Xferred = Re_Xferred + 1 + END DO END IF END SUBROUTINE SC_UnPackOutput - SUBROUTINE SC_C2Fary_CopyOutput( OutputData, ErrStat, ErrMsg ) + SUBROUTINE SC_C2Fary_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) TYPE(SC_OutputType), INTENT(INOUT) :: OutputData INTEGER(IntKi), INTENT( OUT) :: ErrStat CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers ! + LOGICAL :: SkipPointers_local ErrStat = ErrID_None ErrMsg = "" - ! -- fromSC Output Data fields - IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%fromSC ) ) THEN - NULLIFY( OutputData%fromSC ) + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers ELSE - CALL C_F_POINTER(OutputData%C_obj%fromSC, OutputData%fromSC, (/OutputData%C_obj%fromSC_Len/)) + SkipPointers_local = .false. + END IF + + ! -- fromSC Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. C_ASSOCIATED( OutputData%C_obj%fromSC ) ) THEN + NULLIFY( OutputData%fromSC ) + ELSE + CALL C_F_POINTER(OutputData%C_obj%fromSC, OutputData%fromSC, (/OutputData%C_obj%fromSC_Len/)) + END IF END IF END SUBROUTINE SC_C2Fary_CopyOutput + SUBROUTINE SC_F2C_CopyOutput( OutputData, ErrStat, ErrMsg, SkipPointers ) + TYPE(SC_OutputType), INTENT(INOUT) :: OutputData + INTEGER(IntKi), INTENT( OUT) :: ErrStat + CHARACTER(*), INTENT( OUT) :: ErrMsg + LOGICAL,OPTIONAL,INTENT(IN ) :: SkipPointers + ! + LOGICAL :: SkipPointers_local + ErrStat = ErrID_None + ErrMsg = "" + + IF (PRESENT(SkipPointers)) THEN + SkipPointers_local = SkipPointers + ELSE + SkipPointers_local = .false. + END IF + + ! -- fromSC Output Data fields + IF ( .NOT. SkipPointers_local ) THEN + IF ( .NOT. ASSOCIATED(OutputData%fromSC)) THEN + OutputData%c_obj%fromSC_Len = 0 + OutputData%c_obj%fromSC = C_NULL_PTR + ELSE + OutputData%c_obj%fromSC_Len = SIZE(OutputData%fromSC) + IF (OutputData%c_obj%fromSC_Len > 0) & + OutputData%c_obj%fromSC = C_LOC( OutputData%fromSC( LBOUND(OutputData%fromSC,1) ) ) + END IF + END IF + END SUBROUTINE SC_F2C_CopyOutput + SUBROUTINE SC_Input_ExtrapInterp(u, t, u_out, t_out, ErrStat, ErrMsg ) ! @@ -1110,12 +1230,12 @@ SUBROUTINE SC_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) REAL(DbKi) :: t(2) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'SC_Input_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -1128,13 +1248,13 @@ SUBROUTINE SC_Input_ExtrapInterp1(u1, u2, tin, u_out, tin_out, ErrStat, ErrMsg ) CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) IF (ASSOCIATED(u_out%toSC) .AND. ASSOCIATED(u1%toSC)) THEN - ALLOCATE(b1(SIZE(u_out%toSC,1))) - ALLOCATE(c1(SIZE(u_out%toSC,1))) - b1 = -(u1%toSC - u2%toSC)/t(2) - u_out%toSC = u1%toSC + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%toSC,1),UBOUND(u_out%toSC,1) + b = -(u1%toSC(i1) - u2%toSC(i1)) + u_out%toSC(i1) = u1%toSC(i1) + b * ScaleFactor + END DO END IF ! check if allocated END SUBROUTINE SC_Input_ExtrapInterp1 @@ -1165,13 +1285,14 @@ SUBROUTINE SC_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM REAL(DbKi) :: t(3) ! Times associated with the Inputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'SC_Input_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -1190,14 +1311,14 @@ SUBROUTINE SC_Input_ExtrapInterp2(u1, u2, u3, tin, u_out, tin_out, ErrStat, ErrM CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) IF (ASSOCIATED(u_out%toSC) .AND. ASSOCIATED(u1%toSC)) THEN - ALLOCATE(b1(SIZE(u_out%toSC,1))) - ALLOCATE(c1(SIZE(u_out%toSC,1))) - b1 = (t(3)**2*(u1%toSC - u2%toSC) + t(2)**2*(-u1%toSC + u3%toSC))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*u1%toSC + t(3)*u2%toSC - t(2)*u3%toSC ) / (t(2)*t(3)*(t(2) - t(3))) - u_out%toSC = u1%toSC + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(u_out%toSC,1),UBOUND(u_out%toSC,1) + b = (t(3)**2*(u1%toSC(i1) - u2%toSC(i1)) + t(2)**2*(-u1%toSC(i1) + u3%toSC(i1)))* scaleFactor + c = ( (t(2)-t(3))*u1%toSC(i1) + t(3)*u2%toSC(i1) - t(2)*u3%toSC(i1) ) * scaleFactor + u_out%toSC(i1) = u1%toSC(i1) + b + c * t_out + END DO END IF ! check if allocated END SUBROUTINE SC_Input_ExtrapInterp2 @@ -1276,12 +1397,12 @@ SUBROUTINE SC_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg REAL(DbKi) :: t(2) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd CHARACTER(*), PARAMETER :: RoutineName = 'SC_Output_ExtrapInterp1' - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -1294,13 +1415,13 @@ SUBROUTINE SC_Output_ExtrapInterp1(y1, y2, tin, y_out, tin_out, ErrStat, ErrMsg CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(2) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / t(2) IF (ASSOCIATED(y_out%fromSC) .AND. ASSOCIATED(y1%fromSC)) THEN - ALLOCATE(b1(SIZE(y_out%fromSC,1))) - ALLOCATE(c1(SIZE(y_out%fromSC,1))) - b1 = -(y1%fromSC - y2%fromSC)/t(2) - y_out%fromSC = y1%fromSC + b1 * t_out - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%fromSC,1),UBOUND(y_out%fromSC,1) + b = -(y1%fromSC(i1) - y2%fromSC(i1)) + y_out%fromSC(i1) = y1%fromSC(i1) + b * ScaleFactor + END DO END IF ! check if allocated END SUBROUTINE SC_Output_ExtrapInterp1 @@ -1331,13 +1452,14 @@ SUBROUTINE SC_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err REAL(DbKi) :: t(3) ! Times associated with the Outputs REAL(DbKi) :: t_out ! Time to which to be extrap/interpd INTEGER(IntKi) :: order ! order of polynomial fit (max 2) - REAL(DbKi) :: b0 ! temporary for extrapolation/interpolation - REAL(DbKi) :: c0 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: b1 ! temporary for extrapolation/interpolation - REAL(DbKi),ALLOCATABLE,DIMENSION(:) :: c1 ! temporary for extrapolation/interpolation + REAL(DbKi) :: b ! temporary for extrapolation/interpolation + REAL(DbKi) :: c ! temporary for extrapolation/interpolation + REAL(DbKi) :: ScaleFactor ! temporary for extrapolation/interpolation INTEGER(IntKi) :: ErrStat2 ! local errors CHARACTER(ErrMsgLen) :: ErrMsg2 ! local errors CHARACTER(*), PARAMETER :: RoutineName = 'SC_Output_ExtrapInterp2' + INTEGER :: i01 ! dim1 level 0 counter variable for arrays of ddts + INTEGER :: i1 ! dim1 counter variable for arrays ! Initialize ErrStat ErrStat = ErrID_None ErrMsg = "" @@ -1356,14 +1478,14 @@ SUBROUTINE SC_Output_ExtrapInterp2(y1, y2, y3, tin, y_out, tin_out, ErrStat, Err CALL SetErrStat(ErrID_Fatal, 't(1) must not equal t(3) to avoid a division-by-zero error.', ErrStat, ErrMsg,RoutineName) RETURN END IF + + ScaleFactor = t_out / (t(2) * t(3) * (t(2) - t(3))) IF (ASSOCIATED(y_out%fromSC) .AND. ASSOCIATED(y1%fromSC)) THEN - ALLOCATE(b1(SIZE(y_out%fromSC,1))) - ALLOCATE(c1(SIZE(y_out%fromSC,1))) - b1 = (t(3)**2*(y1%fromSC - y2%fromSC) + t(2)**2*(-y1%fromSC + y3%fromSC))/(t(2)*t(3)*(t(2) - t(3))) - c1 = ( (t(2)-t(3))*y1%fromSC + t(3)*y2%fromSC - t(2)*y3%fromSC ) / (t(2)*t(3)*(t(2) - t(3))) - y_out%fromSC = y1%fromSC + b1 * t_out + c1 * t_out**2 - DEALLOCATE(b1) - DEALLOCATE(c1) + DO i1 = LBOUND(y_out%fromSC,1),UBOUND(y_out%fromSC,1) + b = (t(3)**2*(y1%fromSC(i1) - y2%fromSC(i1)) + t(2)**2*(-y1%fromSC(i1) + y3%fromSC(i1)))* scaleFactor + c = ( (t(2)-t(3))*y1%fromSC(i1) + t(3)*y2%fromSC(i1) - t(2)*y3%fromSC(i1) ) * scaleFactor + y_out%fromSC(i1) = y1%fromSC(i1) + b + c * t_out + END DO END IF ! check if allocated END SUBROUTINE SC_Output_ExtrapInterp2 diff --git a/reg_tests/executeOpenfastLinearRegressionCase.py b/reg_tests/executeOpenfastLinearRegressionCase.py index 8d92c94ba0..6bb34d8ba7 100644 --- a/reg_tests/executeOpenfastLinearRegressionCase.py +++ b/reg_tests/executeOpenfastLinearRegressionCase.py @@ -142,7 +142,7 @@ def isclose(a, b, rel_tol=1e-09, abs_tol=0.0): else: names = os.listdir(src) for name in names: - if name is "ServoData": + if name == "ServoData": continue srcname = os.path.join(src, name) dstname = os.path.join(dst, name) @@ -198,16 +198,16 @@ def isclose(a, b, rel_tol=1e-09, abs_tol=0.0): local_handle.readline() # the next 10 lines are simulation info; save what we need - for i in range(10): + for i in range(11): b_line = baseline_handle.readline() l_line = local_handle.readline() - if i == 4: + if i == 5: b_num_continuous_states = int(b_line.split()[-1]) l_num_continuous_states = int(l_line.split()[-1]) - elif i == 7: + elif i == 8: b_num_inputs = int(b_line.split()[-1]) l_num_inputs = int(l_line.split()[-1]) - elif i == 8: + elif i == 9: b_num_outputs = int(b_line.split()[-1]) l_num_outputs = int(l_line.split()[-1]) diff --git a/reg_tests/lib/fast_io.py b/reg_tests/lib/fast_io.py index 07b7d74255..c730f99373 100644 --- a/reg_tests/lib/fast_io.py +++ b/reg_tests/lib/fast_io.py @@ -86,11 +86,17 @@ def fread(fid, n, type): FileFmtID_WithTime = 1 # File identifiers used in FAST FileFmtID_WithoutTime = 2 FileFmtID_NoCompressWithoutTime = 3 - LenName = 10 # number of characters per channel name - LenUnit = 10 # number of characters per unit name + FileFmtID_ChanLen_In = 4 with open(filename, 'rb') as fid: FileID = fread(fid, 1, 'int16')[0] # FAST output file format, INT(2) + + if FileID == FileFmtID_ChanLen_In: + LenName = fread(fid, 1, 'int16')[0] # Number of characters in channel names and units + else: + LenName = 10 # default number of characters per channel name + + NumOutChans = fread(fid, 1, 'int32')[0] # The number of output channels, INT(4) NT = fread(fid, 1, 'int32')[0] # The number of time steps, INT(4) @@ -116,7 +122,7 @@ def fread(fid, n, type): ChanUnit = [] # initialize the ChanUnit cell array for iChan in range(NumOutChans + 1): - ChanUnitASCII = fread(fid, LenUnit, 'uint8') # ChanUnit converted to numeric ASCII + ChanUnitASCII = fread(fid, LenName, 'uint8') # ChanUnit converted to numeric ASCII ChanUnit.append("".join(map(chr, ChanUnitASCII)).strip()[1:-1]) # get the channel time series diff --git a/reg_tests/r-test b/reg_tests/r-test index 1da2c702c4..8fb74c6e5a 160000 --- a/reg_tests/r-test +++ b/reg_tests/r-test @@ -1 +1 @@ -Subproject commit 1da2c702c479782032e3ad13a8bff32b48e28be7 +Subproject commit 8fb74c6e5aca388b72488c88df5032df9a340491 diff --git a/vs-build/AeroDyn/AeroDyn_Driver.vfproj b/vs-build/AeroDyn/AeroDyn_Driver.vfproj index 88f796b098..df3e8d2c01 100644 --- a/vs-build/AeroDyn/AeroDyn_Driver.vfproj +++ b/vs-build/AeroDyn/AeroDyn_Driver.vfproj @@ -117,6 +117,7 @@ + diff --git a/vs-build/BeamDyn/BeamDyn-w-registry.sln b/vs-build/BeamDyn/BeamDyn-w-registry.sln index a881f9d525..5c99185653 100644 --- a/vs-build/BeamDyn/BeamDyn-w-registry.sln +++ b/vs-build/BeamDyn/BeamDyn-w-registry.sln @@ -1,7 +1,7 @@  Microsoft Visual Studio Solution File, Format Version 12.00 -# Visual Studio 2013 -VisualStudioVersion = 12.0.40629.0 +# Visual Studio 15 +VisualStudioVersion = 15.0.28307.902 MinimumVisualStudioVersion = 10.0.40219.1 Project("{6989167D-11E4-40FE-8C1A-2192A86A7E90}") = "BeamDyn", "BeamDyn.vfproj", "{815C302F-A93D-4C22-9329-7112345113C0}" ProjectSection(ProjectDependencies) = postProject @@ -38,18 +38,18 @@ Global {815C302F-A93D-4C22-9329-7112345113C0}.Release|Win32.Build.0 = Release|Win32 {815C302F-A93D-4C22-9329-7112345113C0}.Release|x64.ActiveCfg = Release|x64 {815C302F-A93D-4C22-9329-7112345113C0}.Release|x64.Build.0 = Release|x64 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug_Double|Win32.ActiveCfg = Debug-Double Precision|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug_Double|Win32.Build.0 = Debug-Double Precision|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug_Double|x64.ActiveCfg = Debug-Double Precision|x64 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug_Double|x64.Build.0 = Debug-Double Precision|x64 + {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug_Double|Win32.ActiveCfg = Debug|Win32 + {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug_Double|Win32.Build.0 = Debug|Win32 + {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug_Double|x64.ActiveCfg = Debug|x64 + {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug_Double|x64.Build.0 = Debug|x64 {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug|Win32.ActiveCfg = Debug|Win32 {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug|Win32.Build.0 = Debug|Win32 {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug|x64.ActiveCfg = Debug|x64 {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Debug|x64.Build.0 = Debug|x64 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release_Double|Win32.ActiveCfg = Release-Double Precision|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release_Double|Win32.Build.0 = Release-Double Precision|Win32 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release_Double|x64.ActiveCfg = Release-Double Precision|x64 - {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release_Double|x64.Build.0 = Release-Double Precision|x64 + {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release_Double|Win32.ActiveCfg = Release|Win32 + {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release_Double|Win32.Build.0 = Release|Win32 + {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release_Double|x64.ActiveCfg = Release|x64 + {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release_Double|x64.Build.0 = Release|x64 {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release|Win32.ActiveCfg = Release|Win32 {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release|Win32.Build.0 = Release|Win32 {DA16A3A6-3297-4628-9E46-C6FA0E3C4D16}.Release|x64.ActiveCfg = Release|x64 @@ -58,4 +58,7 @@ Global GlobalSection(SolutionProperties) = preSolution HideSolutionNode = FALSE EndGlobalSection + GlobalSection(ExtensibilityGlobals) = postSolution + SolutionGuid = {37F40376-E0A4-4BB3-A987-A3CF5A440217} + EndGlobalSection EndGlobal diff --git a/vs-build/BeamDyn/BeamDyn.vfproj b/vs-build/BeamDyn/BeamDyn.vfproj index 53d190698d..852d40158e 100644 --- a/vs-build/BeamDyn/BeamDyn.vfproj +++ b/vs-build/BeamDyn/BeamDyn.vfproj @@ -113,6 +113,7 @@ + diff --git a/vs-build/FASTlib/FASTlib.vfproj b/vs-build/FASTlib/FASTlib.vfproj index 00779aed84..1394dd2e70 100644 --- a/vs-build/FASTlib/FASTlib.vfproj +++ b/vs-build/FASTlib/FASTlib.vfproj @@ -11,7 +11,7 @@ - + @@ -20,7 +20,7 @@ - + @@ -29,7 +29,7 @@ - + @@ -38,7 +38,7 @@ - + @@ -47,7 +47,7 @@ - + @@ -56,7 +56,7 @@ - + @@ -65,7 +65,7 @@ - + @@ -74,7 +74,7 @@ - + @@ -83,7 +83,7 @@ - + @@ -92,7 +92,7 @@ - + @@ -101,7 +101,7 @@ - + @@ -110,24 +110,14 @@ - + - + + - - - - - - - - - - - - - + + @@ -303,6 +293,7 @@ + @@ -424,6 +415,7 @@ + @@ -464,6 +456,7 @@ + diff --git a/vs-build/HydroDyn/HydroDynDriver.vfproj b/vs-build/HydroDyn/HydroDynDriver.vfproj index 3b09fce433..4e712e3c88 100644 --- a/vs-build/HydroDyn/HydroDynDriver.vfproj +++ b/vs-build/HydroDyn/HydroDynDriver.vfproj @@ -14,9 +14,9 @@ - + - + diff --git a/vs-build/RunRegistry.bat b/vs-build/RunRegistry.bat index 6c7db0f6ea..3719c14711 100644 --- a/vs-build/RunRegistry.bat +++ b/vs-build/RunRegistry.bat @@ -129,7 +129,7 @@ GOTO checkError :AeroDyn_Driver SET CURR_LOC=%AD_Loc% SET Output_Loc=%CURR_LOC% -%REGISTRY% "%CURR_LOC%\AeroDyn_Driver_Registry.txt" -I %NWTC_Lib_Loc% -I %CURR_LOC% -O %Output_Loc% -noextrap +%REGISTRY% "%CURR_LOC%\AeroDyn_Driver_Registry.txt" -I "%NWTC_Lib_Loc%" -I "%CURR_LOC%" -O "%Output_Loc%" -noextrap GOTO checkError :AFI @@ -258,6 +258,10 @@ SET Output_Loc=%CURR_LOC% %REGISTRY% "%CURR_LOC%\%ModuleName%_Registry.txt" -I "%NWTC_Lib_Loc%" -O "%Output_Loc%" GOTO checkError +:Version +DEL "%Root_Loc%\VersionInfo.obj" "%Root_Loc%\versioninfo.mod" +GOTO end + :checkError ECHO. IF %ERRORLEVEL% NEQ 0 (